{旼컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴� � � � X - P a c k e t � � � � � � X P S C R O L . P A S � � � � Routinen f걊 den Backscroll des QSO-Fensters (Hauptbildschirm) � 읕컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�} Procedure Notiz_Zeigen (* Kanal : Byte *); Type RetPtr = array[-1..maxNotLines+2] of Word; AttPtr = array[-1..maxNotLines+2] of Boolean; Var Groesse : LongInt; Zeilen, abline, von,bis, i,i1,P,a, X,Y,XB, Result : Integer; StartPage, StopPage, Z : Word; b,Nx, AMark, AMerk : Byte; MoStr : String[80]; Save_Name : String[60]; Suchstr : String[30]; ablineStr : String[19]; BlStr, Zstr : String[2]; KC : Sondertaste; VC : Char; NSave : Text; RetFlag, gefunden, fertig, Flag, PFlag, VorEdit, MarkBlock, NowBlock, NowZlnMerk, CurObStat : Boolean; RET : ^RetPtr; BlAttr : ^AttPtr; Label Nochmal, Nochmal1; Procedure GetRam; Var i : Word; Begin if not MarkBlock then begin GetMem(BlAttr,Zeilen); FillChar(BlAttr^,Zeilen,0); for i := 1 to Zeilen do BlAttr^[i] := false; MarkBlock := true; end; End; Function Eig(Nr : Word) : Str2; Begin if (Kanal > 0) and (Page^[RET^[Nr]+1] = Attrib[19]) then Eig := EchoCh else Eig := ''; End; Function Eig2(Nr : Word) : Str2; {//db1ras} Begin If (Kanal > 0) and (Page^[RET^[Nr]+1] = Attrib[19]) then Eig2 := EchoCh + EchoCh Else Eig2 := EchoCh + B1; End; Procedure Array_updaten(Kanal : Byte); Var NotPtr, CRPtr : Pointer; max : Word; ZL : Integer; Begin with K[Kanal]^ do begin FillChar(Page^,maxNotCh,0); if use_EMS then EMS_Seite_einblenden(Kanal,Scr); if use_Vdisk then begin FiResult := ResetBin(ScrollFile,T); Seek(ScrollFile,Pos_im_Scr + NotPos); Blockread(ScrollFile,Page^[0],maxNotCh-1-NotPos,Z); Seek(ScrollFile,Pos_im_Scr); Blockread(ScrollFile,Page^[maxNotCh-1-NotPos],NotPos,Z); FiResult := CloseBin(ScrollFile); end else if use_XMS then begin XMS_to_Data(@Page^[0],XMS_Handle,Pos_im_Scr+NotPos,maxNotCh-1-NotPos); XMS_to_Data(@Page^[maxNotCh-1-NotPos],XMS_Handle,Pos_im_Scr,NotPos); end else begin move(NotCh[Kanal]^[NotPos],Page^[0],maxNotCh-1-NotPos); move(NotCh[Kanal]^[0],Page^[maxNotCh-1-NotPos],NotPos); end; Page^[maxNotCh-1] := 13; max := maxNotCh; end; NotPtr := @Page^[0]; CRPtr := @RET^[1]; asm push ds mov cx, max mov bx, 0 mov dx, 0 les di, CRPtr lds si, NotPtr jmp @Weiter @CR: mov [es:di], bx add di, 2 inc dx jmp @Again @Weiter: mov al, [ds:si] cmp al, 13 je @CR @Again: inc si inc bx Loop @Weiter pop ds mov ZL, dx end; Zeilen := ZL; {***} (* for ZL := 0 to K[Kanal]^.maxNotCh-1 do begin if Page^[ZL] = 13 then begin inc(Zeilen); RET^[Zeilen] := ZL; end; end; *) dec(Zeilen); if Zeilen <= 0 then Zeilen := 1; end; Function BringZeile(Kanal : Byte; Nr : Integer) : String; var P : Word; Hstr : String; Ze : Byte; begin with K[Kanal]^ do begin Hstr := ''; for P := (RET^[Nr]+2) to (RET^[Nr+1]-1) do begin Ze := Page^[P]; if Ze in [1..8,10..31] then begin Ze := Ze + 64; Hstr := Hstr + '^'; end; Hstr := Hstr + chr(Ze); end; BringZeile := Hstr; end; end; Procedure Zeig(Kanal,von,bis : Byte; PLine : Integer); var i,i1,j, Attr : Byte; Hstr : String[80]; Begin i1 := 0; if Zeilen > 1 then for i := von to bis do begin Attr := Page^[RET^[PLine+i1]+1]; if Attr = 254 then Attr := 13; if (MarkBlock and BlAttr^[PLine+i1]) or ((i = Y) and not MarkBlock) then Attr := Attrib[4]; FillChar(Hstr[1],80,32); Hstr[0] := Chr(80); j := Byte(RET^[PLine+i1+1] - RET^[PLine+i1] - 2); if j > 80 then j := 80; move(Page^[RET^[PLine+i1]+2],Hstr[1],j); WritePage(Kanal,1,i,Attr,0,Hstr); inc(i1); end; End; Procedure CursorUp(Kanal : Byte); Begin if abline + Y - von > 1 then begin dec(Y); if Y < von then begin Y := von; dec(abline); Scroll(Dn,1,von,bis); end; Zeig(Kanal,Y,Y+1,abline + Y - von); end; End; Procedure CursorDown(Ka : Byte); Var Merk : Integer; Flag : Boolean; Begin Flag := false; if (K[Ka]^.NeueZeilen > 0) and not MarkBlock and not ((abline < (Zeilen - bis + von)) or (Y < bis)) then begin Merk := Zeilen; Array_updaten(Ka); abline := abline - (K[Ka]^.NeueZeilen - (Zeilen-Merk)); K[Ka]^.ScrZlnMerk := Word(K[Ka]^.ScrZlnMerk + K[Ka]^.NeueZeilen); K[Ka]^.NeueZeilen := 0; if (abline < 1) and (Zeilen > bis - von) then begin abline := 1; Y := von; Zeig(Ka,von,bis,abline); Flag := true; end; end; If (abline + (Y-von) < Zeilen) and not Flag then begin inc(Y); if Y > bis then begin Y := bis; inc(abline); Scroll(Up,1,von,bis); end; Zeig(Ka,Y-1,Y,abline + (Y-1) - von); end; End; Procedure NewBild; Begin if abline > 0 then Zeig(Kanal,von,bis,abline) else Zeig(Kanal,Y,bis,abline + Y-von); End; Procedure CancelBlock; Begin if MarkBlock then begin FreeMem(BlAttr,Zeilen); MarkBlock := false; StartPage := 0; StopPage := 0; Cursor_aus; end; NewBild; End; Begin with K[Kanal]^ do begin BackupBremsen:=true; Nx := (NrStat[2]-1) * 20 + 1; ScrZlnMerk := Word(ScrZlnMerk + NeueZeilen); NeueZeilen := 0; Neu_Bild; RetFlag := false; VorEdit := false; QsoScroll := true; CurObStat := false; MarkBlock := false; NowBlock := false; NowZlnMerk := false; StartPage := 0; StopPage := 0; XB := 1; if Braille80 then X := 80 else X := 1; Zeilen := 0; RET := Nil; Page := Nil; {***}{ GetMem(RET,(maxNotLines+4)*2); } { FillChar(RET^,SizeOf(RET),0); } { GetMem(Page,maxNotCh+86); } GetMem(RET,maxNotLines*2); {//db1ras} FillChar(RET^,SizeOf(RET^),0); {//db1ras} GetMem(Page,maxNotCh); {//db1ras} Array_updaten(Kanal); if Kanal > 0 then begin von := QBeg; bis := QEnd; end else begin von := UnStat + 1; bis := maxZ; end; abline := Zeilen - (bis - von); Y := bis; Zeig(Kanal,Y,Y,abline + Y - von); WriteAttr(1,Y,80,Attrib[4],1); Fertig := false; SuchStr := ''; Nochmal: {NX+1} WriteRam(61,ObStat+2,Attrib[9],1,ConstStr(B1,19)); Repeat i := ((Zeilen + 1) - abline) - (Y - von); i1 := abline + (Y-von); {*****} if MarkBlock then BlStr := S_ch else BlStr := B1; if MarkBlock and BlAttr^[i1] then begin BlStr := '�' + BlStr; if not NowBlock and BlTon then Beep(G^.BLockAnfFreq,G^.BlockPiep1Time); NowBlock := true; end else begin BlStr := B1 + BlStr; if NowBlock and BlTon then Beep(G^.BLockEndFreq,G^.BlockPiep2Time); NowBlock := false; end; abLineStr := SFillStr(4,B1,int_str(i)) + '/' + int_str(Zeilen) + BlStr; {nx+1} WriteRam(61,ObStat+2,Attrib[9],1,EFillStr(9,B1,ablineStr)); if HardCur and not VorEdit then begin if CurObStat then SetzeCursor(X,ObStat+2) else SetzeCursor(X,Y); end else if MarkBlock then SetzeCursor(XB,Y); Repeat if TimerTick > PollTime then begin Uhr_aus; {Nx+12} {**} WriteRam(72,ObStat+2,Attrib[9],1,EFillStr(8,B1,LRK + int_str(NeueZeilen) + RRK)); TNCs_Pollen; if notScroll then begin notScroll := false; if abline > 0 then Zeig(Kanal,von,bis,abline) else Zeig(Kanal,Y,bis,abline + Y-von); end; end; Until _KeyPressed; _ReadKey(KC,VC); PollTime := TimerTick + KeyDelay; if VorEdit then begin if KC in [_Esc,_PgUp,_Alt0,_F11] then begin VorEdit := false; Zeig(Kanal,Y,Y,abline + Y-von); end else if KC in [_AltA.._AltY,_AltZ,_Home,_ShIns,_ShTab,_End,_Ins.._Ret,_Back,_Nix] then Key_Active(Kanal,KC,VC) else Alarm; end else case KC of _Up : CursorUp(Kanal); _Dn : CursorDown(Kanal); _Home : begin if ScrZlnMerk >= Zeilen then ScrZlnMerk := Zeilen - 1; if ScrZlnMerk > (bis - von) then Y := von else Y := bis - ScrZlnMerk; i := abline; abline := Zeilen - ScrZlnMerk + von - Y; if abline > 0 then Zeig(Kanal,von,bis,abline) else begin abline := i; Y := bis - ScrZlnMerk + 1; if Y > bis then Y := bis; Zeig(Kanal,Y,bis,abline + Y - von); end; end; _End : begin ScrZlnMerk := Word(Zeilen - abline - Y + von); NowZlnMerk := true; end; _PgUp : begin { Page up } if abline > 0 then begin abline := abline - (bis-von); if HardCur then Y := von + 1; if abline <= 0 then begin abline := 1; Y := von; end; Zeig(Kanal,von,bis,abline); end;{ else begin Y := bis - Zeilen + 1; Zeig(Kanal,Y,bis,abline + Y-von); end; } end; _PgDn : begin { Page down } PFlag := false; if (NeueZeilen > 0) and not MarkBlock and (abline + bis - von > Zeilen - bis + von) then begin i := Zeilen; Array_updaten(Kanal); abline := abline - (NeueZeilen - (Zeilen-i)); ScrZlnMerk := Word(ScrZlnMerk + NeueZeilen); NeueZeilen := 0; if (abline < 1) and (Zeilen > bis - von) then begin abline := 1; Y := von; Zeig(Kanal,von,bis,abline); PFlag := true; end; end; if not PFlag then if abline > 0 then begin abline := abline + (bis-von); if HardCur then Y := von + 1; if abline > (Zeilen - (bis - von)) then begin abLine := Zeilen - (bis - von); Y := bis; end; Zeig(Kanal,von,bis,abline); end else begin Y := bis; Zeig(Kanal,Y-Zeilen+1,Y,1); end; end; _CtrlPgUp : begin { ^PageUp } if abline > 0 then begin abline := 1; Y := von; Zeig(Kanal,von,bis,abline); end else begin { Y := bis - Zeilen + 1; Zeig(Kanal,Y,bis,abline + Y-von);} end; end; _CtrlPgDn : begin { ^PageDn } if abline > 0 then begin abLine := Zeilen - (bis - von); Y := bis; Zeig(Kanal,von,bis,abline); end else begin Y := bis; Zeig(Kanal,Y-Zeilen+1,Y,1); end; end; _CtrlHome : begin if abline > 0 then begin Y := von; Zeig(Kanal,von,bis,abline); end else begin Y := bis - Zeilen + 1; Zeig(Kanal,Y,bis,abline + Y-von); end; end; _CtrlEnd : begin { ^Ende } if abline > 0 then begin Y := bis; Zeig(Kanal,von,bis,abline); end else begin Y := bis; Zeig(Kanal,Y-Zeilen+1,Y,1); end; end; _ShUp : if abline + (Y-von) > 1 then begin GetRam; if BlAttr^[abline + (Y-von)] then begin BlAttr^[abline + (Y-von)] := false; end else if BlAttr^[abline + (Y-von)-1] then begin BlAttr^[abline + (Y-von)-1] := false; end else BlAttr^[abline + (Y-von)] := true; CursorUp(Kanal); end; _ShDn : if abline + (Y-von) < Zeilen then begin GetRam; if BlAttr^[abline + (Y-von)] then begin BlAttr^[abline + (Y-von)] := false; end else if BlAttr^[abline + (Y-von)+1] then begin BlAttr^[abline + (Y-von)+1] := false; end else BlAttr^[abline + (Y-von)] := true; CursorDown(Kanal); end; _ShRight : begin GetRam; BlAttr^[abline + (Y-von)] := not BlAttr^[abline + (Y-von)]; Zeig(Kanal,Y,Y,abline + Y-von); end; _Alt1 : StartPage := abline + (Y-von); _Alt2 : if StartPage > 0 then begin GetRam; StopPage := abline + (Y-von); if StartPage > StopPage then begin i := StopPage; StopPage := StartPage; StartPage := i; end; for i := StartPage to StopPage do BlAttr^[i] := true; StartPage := 0; NewBild; end else Alarm; _AltF, _AltN : If ((Zeilen + 1) - abline) - (Y - von) > 1 then begin if (KC = _AltN) and (Suchstr > '') then goto Nochmal1; WriteRam(1,Y,Attrib[4],1,EFillStr(80,B1,InfoZeile(7))); GetString(Suchstr,Attrib[4],30,45,Y,KC,0,Ins); Suchstr:=upcasestr(Suchstr); if KC <> _Esc then begin Nochmal1: i := abline + (Y-von) +1; gefunden := false; Repeat gefunden := pos(Suchstr,UpCaseStr(BringZeile(Kanal,i))) > 0; inc(i); Until gefunden or (i > Zeilen); if gefunden then begin if (i > Zeilen - (bis - von)) and ((Zeilen-i) < (bis-Y)) then begin abline := Zeilen - (bis - von); Y := ((i - abline) + von) - 1; end else abline := (i - Y) + (von - 1); if abline > 0 then Zeig(Kanal,von,bis,abline) else Zeig(Kanal,Y,bis,abline + Y-von); if Klingel then Beep(1500,30); end else begin Teil_Bild_Loesch(Y,Y,Attrib[4]); WriteRam(10,Y,Attrib[4],1,InfoZeile(9)); Alarm; Verzoegern(ZWEI); end; end; if abline > 0 then Zeig(Kanal,von,bis,abline) else Zeig(Kanal,bis-Zeilen+1,bis,1); VC := #255; goto Nochmal; end else Alarm; _Ret, _AltZ : if Zeilen > 1 then begin if KC = _AltZ then Zstr := '> ' else Zstr := ''; if Vor_im_EMS then EMS_Seite_einblenden(Kanal,Vor); if RetFlag then Chr_Vor_Show(Kanal,_Alt7,#255); VorWrite[Kanal]^[stV] := Zstr + BringZeile(Kanal,abline + (Y-von)); Chr_Vor_Show(Kanal,_End,#255); RetFlag := true; CursorDown(Kanal); goto Nochmal; end else Alarm; _AltG : begin SysopParm := true; PassRetry := 1; PassRight := 1; SysopArt := LRK + CutStr(User_Name) + RRK; MoStr := BringZeile(Kanal,abline + (Y-von)); if pos(RSK,MoStr) = 0 then MoStr := RSK + MoStr; Password_Auswert(Kanal,MoStr + M1); end; _AltH : XP_Help(G^.OHelp[19]); _AltM : if Kanal = 0 then begin MoStr := BringZeile(Kanal,abline + (Y-von)); i := pos(LRK,MoStr); i1 := pos(LRK + B1,MoStr); if (i = 1) and (i1 = 4) then delete(MoStr,1,5); i := pos(fm,MoStr); i1 := pos(zu,MoStr); if (i > 0) and (i1 > i) then begin delete(MoStr,i1,3); delete(MoStr,1,i+2); end; i := pos(DP,MoStr); if i = 2 then delete(MoStr,1,2); i := pos(RSK,MoStr); if i <= 10 then MoStr[i] := B1; FreeMonitorKanal(b,ParmStr(1,B1,MoStr) + B1 + ParmStr(2,B1,MoStr)); if b > 0 then begin Calls_Monitoren(b,ParmStr(1,B1,MoStr) + B1 + ParmStr(2,B1,MoStr)); if abline > 0 then Zeig(Kanal,von,bis,abline) else Zeig(Kanal,bis-Zeilen+1,bis,1); end else Alarm; end else Alarm; _AltP : begin if (LPT_vorhanden and not LPT_Error(PrtPort)) then begin if MarkBlock then begin for i := 1 to Zeilen do if BlAttr^[i] then Write_Drucker(Kanal,Eig(i) + BringZeile(Kanal,i) + M1); CancelBlock; end else for i := abline + (Y-von) to Zeilen do Write_Drucker(Kanal,Eig(i) + BringZeile(Kanal,i) + M1); end else begin WriteRam(1,Y,Attrib[4],1,EFillStr(80,B1,InfoZeile(290))); Alarm; Verzoegern(ZWEI); end; Zeig(Kanal,Y,Y,abline + Y-von); VC := #255; goto Nochmal; end; _AltS : Begin { Saven } WriteRam(1,Y,Attrib[4],1,EFillStr(80,B1,B1+InfoZeile(142)+B1)); Save_Name := Konfig.SavVerz + 'SCR.'+ SFillStr(3,'0',int_str(Kanal)); GetString(Save_Name,Attrib[4],60,9,Y,KC,1,Ins); if KC <> _Esc then begin Assign(NSave,Save_Name); Result := AppendTxt(NSave); if Result <> 0 then Result := RewriteTxt(NSave); if Result = 0 then begin if MarkBlock then begin for i := 1 to Zeilen do if BlAttr^[i] then Writeln(NSave,Eig(i),BringZeile(Kanal,i)); CancelBlock; end else for i := abline + (Y-von) to Zeilen do Writeln(NSave,Eig(i),BringZeile(Kanal,i)); FiResult := CloseTxt(NSave); end else begin WriteRam(1,Y,Attrib[4],1,EFillStr(80,B1,B1 + InfoZeile(75) + DP + B2 + Save_Name)); Alarm; Verzoegern(ZWEI); end; end; VC := #255; Zeig(Kanal,Y,Y,abline + Y-von); end; _AltW : Begin { Kopie //db1ras} Flag := false; WriteRam(1,Y,Attrib[4],1,EFillStr(80,B1, B1+InfoZeile(460)+B1)); GetString(UeberNr,Attrib[4],2,length(InfoZeile(460))+3, Y,KC,0,Flag); a := str_int(UeberNr); If KC = _Ret Then Begin If a in [0..maxLink] Then Begin If K[a]^.connected or K[a]^.Test Then Begin K[a]^.EigFlag := true; K[a]^.WishBuf := true; If MarkBlock Then Begin For i := 1 To Zeilen Do If BlAttr^[i] Then S_PAC(a,NU,false,Eig2(i)+BringZeile(Kanal,i)+M1); CancelBlock; End Else For i := abline + (Y-von) To Zeilen Do S_PAC(a,NU,false,Eig2(i)+BringZeile(Kanal,i)+M1); S_PAC(a,NU,true,''); K[a]^.EigFlag := false; End; End Else Alarm; End; VC := #255; Zeig(Kanal,Y,Y,abline + Y-von); End; _ShTab : begin CurObStat := not CurObStat; if CurObStat then X := ((NrStat[2]-1)*20)+1 else X := 80; end; _Tab : CancelBlock; _Ins : begin VorEdit := true; WriteRam(1,Y,Attrib[4],1,ConstStr(#24,80)); Chr_Vor_Show(Kanal,_Nix,#255); end; _F1.._F10, _F12 : begin ch_aus := true; SK_out := KC; VC_out := VC; Fertig := true; end; _Del, _Esc : Fertig := true; _Andere : Alarm; else Alarm; end; (* case *) Until Fertig; if MarkBlock then FreeMem(BlAttr,Zeilen); if ZlnMerk and not NowZlnMerk then ScrZlnMerk := Word(Zeilen - abline - Y + von); {***}{ FreeMem(Page,maxNotCh+86); } { FreeMem(RET,(maxNotLines+4)*2); } FreeMem(Page,maxNotCh); {//db1ras} FreeMem(RET,maxNotLines*2); {//db1ras} QsoScroll := false; Cursor_aus; if HardCur then JumpRxScr := true; Neu_Bild; end; BackupBremsen:=false; End; Procedure FileScroll (* Kanal : Byte *); var KC : Sondertaste; VC, Hch : Char; Lines : ^MbxTypPtr; A,X,Y, maxY, minY, Nx, Attr, XMerk, Spalte, AnzSp, Yofs : Byte; maxL, Result : Word; i,i1, Lpos, Fpos, MFpos, FSize, Zmax, MmaxL : LongInt; HLstr : MbxZeile; Bstr, Hstr : String[80]; Save_Name : String[60]; SuchStr : String[30]; Ende, Found, update, RetFlag, New_Lines, CurObStat, UpScroll, Fail, VorEdit, First : Boolean; BoxSave : Text; Function MakeStr(Zeile : MbxZeile; Art : Byte; var Col : Byte) : StrBox; var Hstr : String[BoxRec]; Begin move(Zeile,Hstr[1],BoxRec); Hstr[0] := Chr(BoxRec); Col := Ord(Hstr[81]); case Art of 0 : Hstr[0] := Chr(80); 1 : delete(Hstr,1,83); 2 : Hstr := copy(Hstr,82,2); end; MakeStr := Hstr; End; Procedure DoPage(von,bis : Byte); var i,i1 : LongInt; Hstr : String[80]; begin i1 := Lpos - Y + von; for i := von to bis do begin Hstr := MakeStr(Lines^[i1],0,Attr); WriteRam(1,i+Yofs,Attr,1,Hstr); inc(i1); end; end; Procedure Updaten(Kanal : Byte); var l : LongInt; Begin with K[Kanal]^ do begin Seek(DBox,MFpos); for l := 1 to MmaxL do BlockWrite(DBox,Lines^[l],1,Result); update := false; end; End; Procedure HoleLines(Kanal : Byte; Stelle : LongInt); var l : LongInt; Result : Word; Begin with K[Kanal]^ do begin if update then Updaten(Kanal); FillChar(Lines^,SizeOf(Lines^),0); l := 1; Seek(DBox,Stelle); While not Eof(DBox) and (l <= maxL) do begin BlockRead(DBox,Lines^[l],1,Result); inc(l); end; MFpos := Stelle; MmaxL := maxL; end; End; Procedure CursorDown(Kanal : Byte); Begin with K[Kanal]^ do begin if (Fpos + Lpos) < FSize then begin DoPage(Y,Y); if Lpos < maxL then inc(Lpos) else begin Fpos := Fpos + maxL - Zmax + 1; Lpos := Zmax; if Fpos + maxL > FSize then begin Lpos := maxL + Fpos + Zmax - FSize; Fpos := FSize - maxL; end; HoleLines(Kanal,Fpos); end; if Y < Zmax then inc(Y) else begin Scroll(Up,1,minY,maxY); DoPage(Y,Y); end; end else Alarm; end; End; Procedure CursorUp(Kanal : Byte); Begin with K[Kanal]^ do begin if (Fpos + Lpos > 1) then begin DoPage(Y,Y); if Lpos > 1 then dec(Lpos) else begin Fpos := Fpos - maxL + Zmax - 1; Lpos := maxL - Zmax + 1; if Fpos < 0 then begin Lpos := Fpos + 1 - Zmax + maxL; Fpos := 0; end; HoleLines(Kanal,Fpos); end; if Y > 1 then dec(Y) else begin Scroll(Dn,1,minY,maxY); DoPage(Y,Y); end; end else Alarm; end; End; Procedure MakeRead(Kanal,Art : Byte; var FFlag : Boolean); var VwStr : String[80]; Nstr : String[12]; RubStr : String[12]; Astr : String[2]; Typ, A,b : Byte; Procedure MakeTransfer; Begin VwStr := TrStr + B1 + RubStr + B1 + Nstr + B1; if Typ in [1,14] then VwStr := VwStr + RSK + B1; WriteRam(1,Y+Yofs,Attrib[4],1,ConstStr(B1,80)); GetString(VwStr,Attrib[4],60,2,Y+Yofs,KC,3,Ins); if KC <> _Esc then begin Lines^[Lpos][b] := RepCh; A := Attrib[19]; end else FFlag := true; End; Begin with K[Kanal]^ do begin VwStr := ''; FFlag := false; b := 80; Hstr := MakeStr(Lines^[Lpos],0,Attr); Astr := MakeStr(Lines^[Lpos],2,Attr); Typ := Ord(Astr[2]); case Typ of 1: begin (* DBOX *) case Astr[1] of 'C': begin (* CHECK-Eintrag *) RubStr := MakeStr(Lines^[Lpos],1,Attr); KillEndBlanks(Rubstr); Nstr := ParmStr(4,B1,Hstr); if length(Nstr) > 8 then begin Nstr := copy(Nstr,9,4); While copy(Nstr,1,1) = Pkt do delete(Nstr,1,1); end else Nstr := ParmStr(1,B1,Hstr); case Art of 0: begin (* R ABC X *) A := Attrib[19]; VwStr := ReadStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* E ABC X *) A := Attrib[20]; VwStr := EraseStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; 2: begin (* SETL ABC X #Y *) A := Attrib[20]; VwStr := SetStr + B1 + RubStr + B1 + Nstr + B1 + LZ + int_str(G^.SETL[SETNr]); Lines^[Lpos][b] := SetCh; end; 7: begin (* REP ABC X *) A := Attrib[19]; VwStr := RepStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := RepCh; end; 11: begin (* TR ABC X > ... *) MakeTransfer; end; else FFlag := true; end; end; 'L': begin (* LIST-Eintrag *) RubStr := MakeStr(Lines^[Lpos],1,Attr); KillEndBlanks(RubStr); Nstr := ParmStr(1,B1,Hstr); case Art of 0: begin (* R ABC X *) A := Attrib[19]; VwStr := ReadStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* E ABC X *) A := Attrib[20]; VwStr := EraseStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; 2: begin (* SETL ABC X #Y *) A := Attrib[20]; VwStr := SetStr + B1 + RubStr + B1 + Nstr + B1 + LZ + int_str(G^.SETL[SETNr]); Lines^[Lpos][b] := SetCh; end; 7: begin (* REP ABC X *) A := Attrib[19]; VwStr := RepStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := RepCh; end; 11: begin (* TR ABC X > ... *) MakeTransfer; end; else FFlag := true; end; end; 'R': begin (* EL-Eintr꼏e, Dateien *) case Art of 4 : VwStr := BinStr; (* EL B *) 5 : VwStr := BsStr; (* EL BS *) 6 : VwStr := PlusStr; (* EL 7 *) else VwStr := Readstr; (* EL R *) end; A := Attrib[19]; VwStr := RunStr + B1 + ElStr + B1 + VwStr + B1 + ParmStr(1,B1,Hstr); Lines^[Lpos][b] := ReadCh; end; 'V': begin (* EL-Eintr꼏e, Verzeichnisse *) A := Attrib[19]; VwStr := RunStr + B1 + ElStr + B1 + DirStr + B1 + CutStr(Hstr); (* EL D *) Lines^[Lpos][b] := ReadCh; end; else FFlag := true; end; end; 2: begin (* BBOX *) case Astr[1] of 'C': begin (* CHECK-Eintrag *) RubStr := MakeStr(Lines^[Lpos],1,Attr); KillEndBlanks(Rubstr); Nstr := ParmStr(4,B1,Hstr); if length(Nstr) > 8 then begin Nstr := copy(Nstr,9,4); While copy(Nstr,1,1) = Pkt do delete(Nstr,1,1); end else Nstr := ParmStr(1,B1,Hstr); case Art of 0: begin (* R ABC X *) A := Attrib[19]; VwStr := ReadStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* E ABC X *) A := Attrib[20]; VwStr := EraseStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; 2: begin (* SETL ABC X #Y *) A := Attrib[20]; VwStr := SetStr + B1 + RubStr + B1 + Nstr + B1 + LZ + int_str(G^.SETL[SETNr]); Lines^[Lpos][b] := SetCh; end; 7: begin (* REP ABC X *) A := Attrib[19]; VwStr := RepStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := RepCh; end; 9: begin (* K ABC X *) A := Attrib[19]; VwStr := KbStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := KbCh; end; 11: begin (* TR ABC X ... *) MakeTransfer; end; else FFlag := true; end; end; 'L': begin (* LIST-Eintrag *) RubStr := MakeStr(Lines^[Lpos],1,Attr); KillEndBlanks(RubStr); Nstr := ParmStr(1,B1,Hstr); case Art of 0: begin (* R ABC X *) A := Attrib[19]; VwStr := ReadStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* E ABC X *) A := Attrib[20]; VwStr := EraseStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; 2: begin (* SETL ABC X #Y *) A := Attrib[20]; VwStr := SetStr + B1 + RubStr + B1 + Nstr + B1 + LZ + int_str(G^.SETL[SETNr]); Lines^[Lpos][b] := SetCh; end; 7: begin (* REP ABC X *) A := Attrib[19]; VwStr := RepStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := RepCh; end; 9: begin (* K ABC X *) A := Attrib[19]; VwStr := KbStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := KbCh; end; 11: begin (* TR ABC X ... *) MakeTransfer; end; else FFlag := true; end; end; 'R': begin (* EL-Eintr꼏e, Dateien *) case Art of 4 : VwStr := BinStr; (* EL B *) 5 : VwStr := BsStr; (* EL BS *) 6 : VwStr := PlusStr; (* EL 7 *) else VwStr := Readstr; (* EL R *) end; A := Attrib[19]; VwStr := ElStr + B1 + VwStr + B1 + ParmStr(1,B1,Hstr); Lines^[Lpos][b] := ReadCh; end; 'V': begin (* EL-Eintr꼏e, Verzeichnisse *) A := Attrib[19]; VwStr := ElStr + B1 + DirStr + B1 + CutStr(Hstr); (* EL D *) Lines^[Lpos][b] := ReadCh; end; else FFlag := true; end; end; 3: begin (* FBOX *) case Astr[1] of 'C': begin (* CHECK-Eintrag *) KillStartBlanks(Hstr); Nstr := CutStr(Hstr); case Art of 0: begin (* R XXX *) A := Attrib[19]; VwStr := ReadStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* E XXX *) A := Attrib[20]; VwStr := EraseStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; else FFlag := true; end; {art} end; {C} end; {case astr} end; {3} 4: begin (* WBOX *) case Astr[1] of 'C': begin (* CHECK-Eintrag *) KillStartBlanks(Hstr); Nstr := CutStr(Hstr); case Art of 0: begin (* R XXX *) A := Attrib[19]; VwStr := ReadStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* E XXX *) A := Attrib[20]; VwStr := EraseStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; else FFlag := true; end; end; else FFlag := true; end; end; 5: begin (* EBOX *) case Astr[1] of 'L': begin (* LIST-Eintrag *) KillStartBlanks(Hstr); Nstr := CutStr(Hstr); case Art of 0: begin (* R XXX *) (* RB XXX *) A := Attrib[19]; if UpCaseStr(ParmStr(8,B1,Hstr)) = 'D' then VwStr := RBinStr + B1 + Nstr else VwStr := ReadStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* K XXX *) A := Attrib[20]; VwStr := KillStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; 8: begin (* U XXX *) A := Attrib[19]; VwStr := UnprStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 10: begin (* CRC XXX *) A := Attrib[19]; VwStr := CrcStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; else FFlag := true; end; end; else FFlag := true; end; end; 14: begin (* TBOX *) case Astr[1] of 'C': begin (* CHECK-Eintrag *) RubStr := MakeStr(Lines^[Lpos],1,Attr); KillEndBlanks(Rubstr); Nstr := ParmStr(4,B1,Hstr); if length(Nstr) > 8 then begin Nstr := copy(Nstr,9,4); While copy(Nstr,1,1) = Pkt do delete(Nstr,1,1); end else Nstr := ParmStr(1,B1,Hstr); case Art of 0: begin (* R ABC X *) A := Attrib[19]; VwStr := ReadStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* E ABC X *) A := Attrib[20]; VwStr := EraseStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; 2: begin (* SETL ABC X #Y *) A := Attrib[20]; VwStr := SetStr + B1 + RubStr + B1 + Nstr + B1 + LZ + int_str(G^.SETL[SETNr]); Lines^[Lpos][b] := SetCh; end; 7: begin (* REP ABC X *) A := Attrib[19]; VwStr := RepStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := RepCh; end; 11: begin (* TR ABC X > ... *) MakeTransfer; end; else FFlag := true; end; end; 'L': begin (* LIST-Eintrag *) RubStr := MakeStr(Lines^[Lpos],1,Attr); KillEndBlanks(RubStr); Nstr := ParmStr(1,B1,Hstr); case Art of 0: begin (* R ABC X *) A := Attrib[19]; VwStr := ReadStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := ReadCh; end; 1: begin (* E ABC X *) A := Attrib[20]; VwStr := EraseStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := EraseCh; end; 2: begin (* SETL ABC X #Y *) A := Attrib[20]; VwStr := SetStr + B1 + RubStr + B1 + Nstr + B1 + LZ + int_str(G^.SETL[SETNr]); Lines^[Lpos][b] := SetCh; end; 7: begin (* REP ABC X *) A := Attrib[19]; VwStr := RepStr + B1 + RubStr + B1 + Nstr; Lines^[Lpos][b] := RepCh; end; 11: begin (* TR ABC X > ... *) MakeTransfer; end; else FFlag := true; end; end; else FFlag := true; end; end; else FFlag := true; end; if not FFlag then begin if not RetFlag then Chr_Vor_Show(Kanal,_Alt8,#255) else Chr_Vor_Show(Kanal,_Andere,^J); VorWrite[Kanal]^[stV] := VwStr; update := true; Lines^[Lpos][81] := Chr(A); Chr_Vor_Show(Kanal,_End,#255); RetFlag := true; DoPage(1,Zmax); end; end; End; Function NoHeader(Zeile : MbxZeile) : Boolean; var Attr : Byte; Begin NoHeader := pos('� ',MakeStr(Zeile,0,Attr)) <> 1; End; Begin BackupBremsen:=true; with K[Kanal]^ do begin Neu_Bild; if not ChkLstOpen then OpenDBox(Kanal); BoxScroll := true; if Vor_im_EMS then EMS_Seite_einblenden(Kanal,Vor); if Braille80 then X := 80 else X := 1; Y := 1; Ende := false; VorEdit := false; Nx := (NrStat[2]-1) * 20 + 1; Fpos := 0; Lpos := 1; SuchStr := ''; CurObStat := false; First := true; New_Lines := false; update := false; RetFlag := false; UpScroll := false; Yofs := QBeg - 1; minY := QBeg; maxY := QEnd; Zmax := QEnd - QBeg + 1; Teil_Bild_Loesch(minY,maxY,Attrib[18]); KC := _CtrlPgDn; VC := #255; Repeat if not First then begin Repeat if TimerTick > PollTime then begin New_Lines := false; Uhr_aus; TNCs_Pollen; if (FSize <= (QEnd - QBeg + 5)) and (NewChkLst > 0) then New_Lines := true; end; Until New_Lines or _KeyPressed; if not New_Lines then _ReadKey(KC,VC); end; PollTime := TimerTick + KeyDelay; Fail := false; if FSize <= maxMbxLines then maxL := FSize else maxL := maxMbxLines; if FSize <= Zmax then Zmax := FSize else Zmax := QEnd - Yofs; if maxL <= Zmax then Zmax := maxL; maxY := Zmax + Yofs; if First then begin GetMem(Lines,SizeOf(Lines^)); FillChar(Lines^,SizeOf(Lines^),0); if FSize = 0 then begin First := false; HoleLines(Kanal,0); DoPage(1,Zmax); end; end; if New_Lines then begin New_Lines := false; KC := _Tab; end; if NewChkLst > 0 then begin HoleLines(Kanal,Fpos); NewChkLst := 0; end; if VorEdit then begin if KC in [_Esc,_PgUp,_Alt0,_F11] then begin VorEdit := false; DoPage(Y,Y); end else if KC in [_AltA.._AltY,_AltZ,_Home,_ShIns, _ShTab,_End,_Ins.._Ret,_Back,_Nix] then Key_Active(Kanal,KC,VC) else Alarm; end else case KC of _Andere : begin if UpCase(VC) in [' ','K','L','R','D','B','S','T','7','C','U'] then begin if NoHeader(Lines^[Lpos]) then case UpCase(VC) of ' ' : MakeRead(Kanal,0,Fail); (* R... 123 *) 'T' : MakeRead(Kanal,11,Fail); (* TR IBM 123 *) 'K' : MakeRead(Kanal,9,Fail); (* K IBM 123 *) 'L' : MakeRead(Kanal,2,Fail); (* SETL IBM 123 *) 'R' : MakeRead(Kanal,7,Fail); (* REP IBM 123 *) 'D' : MakeRead(Kanal,3,Fail); (* EL D *) 'B' : MakeRead(Kanal,4,Fail); (* EL B *) 'S' : MakeRead(Kanal,5,Fail); (* EL BS *) '7' : MakeRead(Kanal,6,Fail); (* EL 7 *) 'C' : MakeRead(Kanal,10,Fail); (* CRC 12345 *) 'U' : MakeRead(Kanal,8,Fail); (* U 12345 *) end else Fail := true; if not Fail then begin if UpScroll then CursorUp(Kanal) else CursorDown(Kanal); end else begin Alarm; DoPage(Y,Y); end; end else if (VC = ^Y) then begin FillChar(Lines^[Lpos],79,B1); update := true; DoPage(Y,Y); end else Alarm; end; _Back : begin UpScroll := not UpScroll; if UpScroll then WriteRam(1,Y+Yofs,Attrib[4],1,EFillStr(80,B1,ConstStr(B1,20) + InfoZeile(87))) else WriteRam(1,Y+Yofs,Attrib[4],1,EFillStr(80,B1,ConstStr(B1,20) + InfoZeile(88))); Verzoegern(700); DoPage(Y,Y); end; _Del, _Esc : Ende := true; _Tab : begin HoleLines(Kanal,Fpos); DoPage(1,Zmax); end; _Ret : begin if not RetFlag then begin if NoHeader(Lines^[Lpos]) then begin MakeRead(Kanal,0,Fail); if Fail then Alarm; end else Alarm; end; if RetFlag then begin Chr_Vor_Show(Kanal,_Ret,#13); RetFlag := false; end; end; _F11, _Alt1.. _Alt5 : begin if KC = _F11 then begin KC := _Alt4; VC := #123; end; if update then Updaten(Kanal); Hstr := MakeStr(Lines^[Lpos],2,Attr); Hch := Hstr[1]; if Hch in ['L','C'] then begin WriteRam(1,Y+Yofs,Attrib[4],1,EFillStr(80,B1,ConstStr(B1,20) + InfoZeile(39))); Hstr := MakeStr(Lines^[Lpos],0,Attr); A := ord(VC) - 119; Bstr := ParmStr(A,B1,Hstr); if A = 1 then Spalte := 1 else Spalte := ParmPos; Bstr := ParmStr(A+1,B1,Hstr); AnzSp := Byte(ParmPos - Spalte); FreeMem(Lines,SizeOf(Lines^)); CheckSort(Kanal,Spalte,AnzSp,Fpos + Lpos - 1,Hch); GetMem(Lines,SizeOf(Lines^)); HoleLines(Kanal,Fpos); DoPage(1,Zmax); end else Alarm; end; _Ins : begin VorEdit := true; WriteRam(1,Y+Yofs,Attrib[4],1,ConstStr(#24,80)); Chr_Vor_Show(Kanal,_Nix,#255); end; _AltC : begin Hstr := MakeStr(Lines^[Lpos],0,Attr); KillEndBlanks(Hstr); VorWrite[Kanal]^[stV] := Hstr; Chr_Vor_Show(Kanal,_End,#255); Chr_Vor_Show(Kanal,_Alt7,#255); if UpScroll then CursorUp(Kanal) else CursorDown(Kanal); end; _AltE : if NoHeader(Lines^[Lpos]) then begin MakeRead(Kanal,1,Fail); if not Fail then begin if UpScroll then CursorUp(Kanal) else CursorDown(Kanal); end else Alarm; end else Alarm; _AltH : XP_Help(G^.OHelp[29]); _AltF, _AltN : begin if (KC = _AltF) or ((KC = _AltN) and (SuchStr = '')) then begin WriteRam(1,Y+Yofs,Attrib[4],1,EFillStr(80,B1,InfoZeile(7))); GetString(Suchstr,Attrib[4],30,45,Y+Yofs,KC,0,Ins); end; if (KC <> _Esc) and (SuchStr > '') then begin Suchstr:=UpcaseStr(Suchstr); Found := false; Seek(DBox,Fpos + Lpos); While not Found and not Eof(DBox) do begin BlockRead(DBox,HLstr,1,Result); Hstr := UpCaseStr(MakeStr(HLstr,0,Attr)); Found := pos(SuchStr,Hstr) > 0; end; if Found then begin Fpos := FilePos(DBox) - Lpos; if Fpos + maxL > FSize then begin Lpos := FilePos(DBox) + maxL - FSize; Fpos := FSize - maxL; end; HoleLines(Kanal,Fpos); if Lpos + Zmax - Y > maxL then Y := Lpos + Zmax - maxL; DoPage(1,Zmax); end else begin Seek(DBox,Fpos); Alarm; end; end; DoPage(Y,Y); end; _AltP : begin if (LPT_vorhanden and (not LPT_Error(PrtPort))) then begin Seek(DBox,Fpos + Lpos - 1); While not Eof(DBox) do begin BlockRead(DBox,HLstr,1,Result); Hstr := MakeStr(HLstr,0,Attr); KillEndBlanks(Hstr); Write_Drucker(Kanal,Hstr +M1); end; Seek(DBox,Fpos); end else begin WriteRam(1,Y+Yofs,Attrib[4],1,EFillStr(80,B1,InfoZeile(290))); Alarm; Verzoegern(ZWEI); end; DoPage(Y,Y); end; _AltS : begin WriteRam(1,Y+Yofs,Attrib[4],1,EFillStr(80,B1,B1+InfoZeile(142)+B1)); Save_Name := Konfig.SavVerz + 'BOX'+ int_str(Kanal) + '.TXT'; GetString(Save_Name,Attrib[4],60,9,Y+Yofs,KC,1,Ins); if KC <> _Esc then begin Assign(BoxSave,Save_Name); Result := AppendTxt(BoxSave); if Result <> 0 then Result := RewriteTxt(BoxSave); if Result = 0 then begin Seek(DBox,Fpos + Lpos - 1); While not Eof(DBox) do begin BlockRead(DBox,HLstr,1,Result); Hstr := MakeStr(HLstr,0,Attr); KillEndBlanks(Hstr); Writeln(BoxSave,Hstr); end; FiResult := CloseTxt(BoxSave); Seek(DBox,Fpos); end else begin WriteRam(1,Y+Yofs,Attrib[4],1,EFillStr(80,B1,B1 + InfoZeile(75) + DP + B2 + Save_Name)); Alarm; Verzoegern(ZWEI); end; end; DoPage(Y,Y); end; _AltF1.._AltF10 : SETNr := Ord(VC) - 103; _CtrlF1 : if G^.SETL[SETNr] > 0 then dec(G^.SETL[SETNr]) else Alarm; _CtrlF2 : if G^.SETL[SETNr] < 365 then inc(G^.SETL[SETNr]) else Alarm; _Right : if X < 80 then inc(X) else Alarm; _Left : if X > 1 then dec(X) else Alarm; _Up : CursorUp(Kanal); _Dn : CursorDown(Kanal); _PgUp : if (Y > 1) or (Fpos + Lpos > 1) then begin Lpos := Lpos - Zmax + 1; if Lpos - Y + 1 < 1 then begin Fpos := Fpos - maxL + Lpos + Zmax - Y; Lpos := maxL - Zmax + Y; if Fpos < 0 then begin Lpos := Lpos + Fpos; Fpos := 0; end; HoleLines(Kanal,Fpos); end; if Lpos - Y + 1 < 1 then begin Lpos := 1; Y := 1; end; DoPage(1,Zmax); end else Alarm; _PgDn : if (Y < Zmax) or (Fpos + Lpos < FSize) then begin Lpos := Lpos + Zmax - 1; if Lpos + Zmax - Y > maxL then begin Fpos := Fpos + Lpos - Y; Lpos := Y; if Fpos + maxL > FSize then begin Lpos := Fpos + maxL - FSize + Y; Fpos := FSize - maxL; end; HoleLines(Kanal,Fpos); end; if Lpos + Zmax - Y > maxL then begin Lpos := maxL; Y := Zmax; end; DoPage(1,Zmax); end else Alarm; _CtrlPgUp : if (Y > 1) or (Fpos + Lpos > 1) then begin Fpos := 0; Lpos := 1; Y := 1; HoleLines(Kanal,Fpos); DoPage(1,Zmax); end else Alarm; _CtrlPgDn : if (Y < Zmax) or (Fpos + Lpos < FSize) or First then begin First := false; Fpos := FSize - maxL; Lpos := maxL; Y := Zmax; HoleLines(Kanal,Fpos); DoPage(1,Zmax); end else Alarm; _Home : begin Fpos := BoxZlnMerk; Lpos := 1; Y := 1; if Fpos + maxL > FSize then begin Lpos := Fpos + maxL - FSize + Y; Fpos := FSize - maxL; end; if Lpos + Zmax - Y > maxL then Y := Lpos + Zmax - maxL; HoleLines(Kanal,Fpos); DoPage(1,Zmax); end; _End : BoxZlnMerk := Fpos + Lpos - 1; _CtrlHome : begin DoPage(Y,Y); Lpos := Lpos - Y + 1; Y := 1; end; _CtrlEnd : begin DoPage(Y,Y); Lpos := Lpos + Zmax - Y; Y := Zmax; end; _ShTab : begin CurObStat := not CurObStat; if CurObStat then begin Xmerk := X; X := ((NrStat[2]-1)*20)+1 end else X := XMerk; end; _ShDel : begin if (fpos+lpos-1 > 0) then begin Fpos := 0; Lpos := 1; Y := 1; Seek(DBox,0); Truncate(DBox); FSize := 0; BoxZlnMerk := 0; FillChar(Lines^,SizeOf(Lines^),0); Teil_Bild_Loesch(minY,maxY,Attrib[18]); end; end; _Nix : ; else Alarm; end; WriteAttr(1,Y+Yofs,80,Attrib[4],1); if HardCur and not VorEdit then begin if CurObStat then SetzeCursor(X,ObStat+2) else SetzeCursor(X,Y+Yofs); end; Hstr := MakeStr(Lines^[Lpos],1,Attr); KillEndBlanks(Hstr); {Nx+1} WriteRam(61,ObStat+2,Attrib[9],1, EFillStr(19,B1,EFillStr(9,B1,Hstr) + SFillStr(5,B1,int_str(Fpos+Lpos)) + SFillStr(4,B1,int_str(G^.SETL[SETNr])) )); Until Ende; if update then Updaten(Kanal); if not (SysArt in SysMenge) then CloseDBox(Kanal); FreeMem(Lines,SizeOf(Lines^)); BoxScroll := false; Neu_Bild; end; backupBremsen:=false; End; {FileScroll} Procedure CheckSort (* Kanal,Spalte,AnzSp : Byte; Dpos : LongInt; SC : Char *); Const maxSLines = 3000; Type LinePtr = Array [1..maxSLines] of ^MbxZeile; var SFeld : ^LinePtr; Mpos, Bpos, Epos : LongInt; Hstr : String[BoxRec]; Hs : MbxZeile; RFlag, bigger : Boolean; SC_Pos : Byte; maxS, i,Zx, Result : Word; Temp1, Temp2 : File; Procedure DBox_in_Buffer(Kanal : Byte); begin with K[Kanal]^ do begin Zx := 0; While (Zx < maxS) and (FilePos(DBox) <= Epos) do begin inc(Zx); BlockRead(DBox,SFeld^[Zx]^,1,Result); end; bigger := FilePos(DBox) <= Epos; end; end; Procedure SortBuffer(N : Word); Var x,i,j : Integer; Change : Boolean; CPtr : Pointer; Begin if N > 1 then begin x := 1; While x <= N do x := x * 3 + 1; x := x div 3; While x > 0 do begin i := x; While i <= N do begin j := i - x; Change := true; While (j > 0) and Change do begin if copy(SFeld^[j]^,Spalte,AnzSp) > copy(SFeld^[j+x]^,Spalte,AnzSp) then begin CPtr := SFeld^[j+x]; SFeld^[j+x] := SFeld^[j]; SFeld^[j] := CPtr; j := j - x; end else Change := false; end; i := i + 1; end; x := x div 3; end; end; End; Begin with K[Kanal]^ do begin SC_Pos := 82; Mpos := Dpos; Seek(DBox,Mpos); Repeat BlockRead(DBox,Hstr[1],1,Result); if Hstr[SC_Pos] = SC then inc(Mpos); Until Eof(DBox) or (Hstr[SC_Pos] <> SC); if Mpos > Dpos then begin dec(Mpos); Epos := Mpos; Repeat Seek(DBox,Mpos); BlockRead(DBox,Hstr[1],1,Result); if Hstr[SC_Pos] = SC then dec(Mpos); Until (Mpos < 0) or (Hstr[SC_Pos] <> SC); Bpos := Mpos + 1; maxS := 0; GetMem(SFeld,SizeOf(SFeld^)); While (MaxAvail > 1000) and (maxS < maxSLines) do begin inc(maxS); GetMem(SFeld^[maxS],SizeOf(MbxZeile)); FillChar(SFeld^[maxS]^,SizeOf(MbxZeile),0); end; Seek(DBox,Bpos); DBox_in_Buffer(Kanal); SortBuffer(Zx); if bigger then begin Assign(Temp1,Konfig.TempVErz + Tmp1Datei); FiResult := RewriteBin(Temp1,BoxRec); Assign(Temp2, Konfig.TempVerz + Tmp2Datei); FiResult := RewriteBin(Temp2,BoxRec); for i := 1 to Zx do BlockWrite(Temp1,SFeld^[i]^,1,Result); Repeat DBox_in_Buffer(Kanal); SortBuffer(Zx); i := 1; Seek(Temp1,0); if not Eof(Temp1) then begin BlockRead(Temp1,Hs,1,Result); RFlag := true; end else RFlag := false; Repeat if (not Eof(Temp1) or RFlag) and (i <= Zx) then begin if copy(SFeld^[i]^,Spalte,AnzSp) < copy(Hs,Spalte,AnzSp) then begin BlockWrite(Temp2,SFeld^[i]^,1,Result); inc(i); end else begin BlockWrite(Temp2,Hs,1,Result); if not Eof(Temp1) then begin BlockRead(Temp1,Hs,1,Result); RFlag := true; end else RFlag := false; end; end; if not RFlag and Eof(Temp1) then begin While i <= Zx do begin BlockWrite(Temp2,SFeld^[i]^,1,Result); inc(i); end; end; if i > Zx then begin if RFlag then BlockWrite(Temp2,Hs,1,Result); While not Eof(Temp1) do begin BlockRead(Temp1,Hs,1,Result); BlockWrite(Temp2,Hs,1,Result); end; end else Until Eof(Temp1) and (i > Zx); if bigger then begin FiResult := CloseBin(Temp1); FiResult := EraseBin(Temp1); FiResult := CloseBin(Temp2); Rename(Temp2,Konfig.TempVerz + Tmp1Datei); Assign(Temp1, Konfig.TempVerz + Tmp1Datei); FiResult := ResetBin(Temp1,BoxRec); Assign(Temp2, Konfig.TempVerz + Tmp2Datei); FiResult := RewriteBin(Temp2,BoxRec); end; Until not bigger; Seek(DBox,Bpos); Seek(Temp2,0); While not Eof(Temp2) do begin BlockRead(Temp2,Hs,1,Result); BlockWrite(DBox,Hs,1,Result); end; FiResult := CloseBin(Temp1); FiResult := CloseBin(Temp2); FiResult := EraseBin(Temp1); FiResult := EraseBin(Temp2); end else begin Seek(DBox,Bpos); for i := 1 to Zx do BlockWrite(DBox,SFeld^[i]^,1,Result); end; for i := 1 to maxS do FreeMem(SFeld^[i],SizeOf(MbxZeile)); FreeMem(SFeld,SizeOf(SFeld^)); end; end; End; Procedure OpenDBox (* Kanal : Byte *); Begin with K[Kanal]^ do begin if not ChkLstOpen then begin if ResetBin(DBox,BoxRec) > 0 then FiResult := RewriteBin(DBox,BoxRec); FSize := FileSize(DBox); ChkLstOpen := true; end; end; End; Procedure CloseDBox(Kanal : Byte); Var Result : Word; Begin with K[Kanal]^ do begin if ChkLstOpen then begin FiResult := CloseBin(DBox); ChkLstOpen := false; end; end; End;