'* --------------- Progarmminfo -----------------  
'* APicBase V1.0a ( AMOS PictureBase ) 
'* Programmgenre : Bilder-Verwaltung   
'* Programmart   : Shareware     
'* Projektstart  : 26-10-94 23:08:05     
'* Projektende   : 18-11-94 19:21:54   
'* ©1994 by Testaware & ®1994 by Volker Stepprath
'* ----------------------------------------------




'* Wenn Programmtask nicht unter AMOS Editor 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
If Prg State<False
   
   '* Requestmeldung & Ctrl+C abschalten  
   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
   Request Off 
   Break Off 
   
   '* Ich WILL den komplett verfügbaren Systemspeicher
   '* Frei nach AMOSPro User Guide  (Fonts / 11.01.03)
   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   Trap Reserve As Data 15,1000000000
   Erase All 
   
End If 



'* Buffer für `Shortcuts`
'~~~~~~~~~~~~~~~~~~~~~~~~
Dim XSC$(4)



'* Variablen globalisieren 
'~~~~~~~~~~~~~~~~~~~~~~~~~ 
Global XBILD,XMEN,XAS20$,XSC$()



'* Standartpalette für alle APB Screens
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Default Palette $AA,$FFF,$EE,$DD,$CC,$BB,$AA,$99,$88,$77,$66,$55,$44,$33,$22,$11,$FFF,$FFF,$B0,$0



_APBSCREEN
_APBMASKE

Amos To Front 

_MAIN


Procedure _MAIN
   
   Do 
      
      _WAIT : N=Param
      
      If N=8 : Rem * BS->Iconify
         X Mouse=X Hard(617)
         Y Mouse=Y Hard(13)
         
      Else If N=27 : Rem * Esc->Ende  
         X Mouse=X Hard(29)
         Y Mouse=Y Hard(13)
         
      Else If N>47 and N<58 : Rem * 1-9
         XMEN=N-49
         X Mouse=X Hard(624)
         Y Mouse=Y Hard(175)
         
      Else If N>64 : Rem * A bis Z->Optionen  
         For I=0 To 4
            If XSC$(I)=Chr$(N)
               Exit 
            End If 
         Next 
         X Mouse=X Hard(124+I*120)
         Y Mouse=Y Hard(175)
         
      End If 
      
      X=X Screen(X Mouse)
      Y=Y Screen(Y Mouse)
      
      
      '* Schließ-Gadget
      '~~~~~~~~~~~~~~~~
      If X>1 and X<31 and Y>0 and Y<15
         Proc _ENDE
      End If 
      
      
      '* Iconify-Gadget
      '~~~~~~~~~~~~~~~~
      If X>608 and X<639 and Y>0 and Y<15
         Proc _ICONIFY["APicBase"]
      End If 
      
      
      '* Slider verschieben
      '~~~~~~~~~~~~~~~~~~~~
      If X>15 and X<625 and Y>147 and Y<159
         Proc _SLIDER
         If XBILD<>Param
            XBILD=Param
            Proc _BILDINFORMATION
         End If 
      End If 
      
      '* Option selektiert 
      '~~~~~~~~~~~~~~~~~~~ 
      If X>12 and X<612 and Y>163 and Y<178
         _O[""]
         N=X-12 : N=(N/120)+1
         _G[12+(N-1)*120,164,131+(N-1)*120,177,1,0]
         If XMEN=1
            On N Proc _BASEEINLADEN,_BASESPEICHERN,_BASEINFO,_ZEIGEBASE,_BASELöSCHEN
         Else If XMEN=2
            On N Proc _ZEIGEBILD,_AUFNEHMEN,_AUSTRAGEN,_LUPE,_INFOEDITOR
         Else If XMEN=3
            On N Proc _IFFZUABK,_ABKZUIFF,_SQUASH,_UNSQUASH,_DATEILöSCHEN
         Else If XMEN=4
            On N Proc _SYSTEMINFO,_SYSTEMTEST,_SYSTEMRESET,_CLITASK,_üBERAPB
         End If 
         Erase 16
         _G[12+(N-1)*120,164,131+(N-1)*120,177,0,0]
      End If 
      
      '* Menüebene umschalten
      '~~~~~~~~~~~~~~~~~~~~~~
      If X>612 and X<627 and Y>163 and Y<178
         _G[613,164,628,177,1,0]
         Wait 5
         _MENU
      End If 
      
   Loop 
   
End Proc


Procedure _BASEEINLADEN
   
   N$=Fsel$("*.APB","","Bitte APB Base auswählen...")
   
   If N$<>""
      
      Trap Open In 1,N$
      If Errtrap=False
         L=Lof(1)
         A$=Input$(1,4)
         Close 1

         If A$="AS20"

            _O["Entpacke Squashed Basedatei..."]

            Reserve As Work 16,L
            Bload N$,Start(16)
            _AS20UNSQUASH[16]

            If Param>False
               Trap Bsave "RAM:AS20.Data",Start(16) To Start(16)+Length(16)
               If Errtrap
                  _FEHLER[Errtrap]
                  Pop Proc
               End If 
               Erase All 
               Trap Load "RAM:AS20.Data"
               Trap Kill "RAM:AS20.Data"
               _O[XAS20$]
            End If 

         Else 

            Trap Load N$

         End If 
         
      Else 
         
         _FEHLER[Errtrap]
         
      End If 
      
   End If 
   

   If Length(1)
      Cls 0,15,146 To 626,156
      _SLIDER
      XBILD=1
      _PUTBOB
      _BILDINFORMATION
   End If 
   
   
End Proc
Procedure _BASESPEICHERN
   
   If Length(1)=False Then _O["Ooops, keine Base installiert !"] : Pop Proc
   
   N$=Fsel$("*.APB","","Bitte zu speichernde Bank wählen...")
   If N$<>""
      
      _R["Sollen die Daten zuvor im","AS20 Format komprimiert werden ?",0]
      If Param

         Trap Save "RAM:APB_Data"
         If Errtrap
            _FEHLER[Errtrap]
            Pop Proc
         End If 
         
         _O["Bitte warten, Basedaten werden komprimiert..."]
         
         Erase All 
         
         Open In 1,"RAM:APB_Data"
         N=Lof(1)
         Reserve As Work 16,N
         Sload 1 To Start(16),N
         Close 1
         
         _AS20SQUASH[16,3]
         
         If Param<1
            
            _O[""]
            _R["Basedaten konnten leider","nicht komprimiert werden !",1]
            
         Else 
            
            _O[XAS20$]
            
            Repeat 
               N=False
               Trap Bsave N$,Start(16) To Start(16)+Length(16)
               If Errtrap
                  _FEHLER[Errtrap]
                  N=Param
               End If 
            Until N=False
            
         End If 
         
         Erase All 
         
         Load "RAM:APB_Data"
         
         Kill "RAM:APB_Data"
         
      Else 
         
         Repeat 
            Trap Save N$
            If Errtrap
               _FEHLER[Errtrap]
               N=Param
            End If 
         Until N=False
         
      End If 
      
   End If 
   
End Proc
Procedure _BASEINFO

   If Length(1)=False Then _O["Ooops, keine Base installiert !"] : Pop Proc

   Cls 0,200,37 To 623,139

'* Gesamtgröße ermitteln 
   For I=0 To Length(1)-1
      Add XG,Leek(Start(15)+I*90+86)
   Next 

'* Erstellungszeitraum ermitteln 
   A=$FFFFFFF : Rem * Maximalwert (Datumanfang)
   E=0 : Rem * Minimalwert (Datumende)
   For I=0 To Length(1)-1
      N=Leek(Start(15)+I*90+66)
      A=Min(A,N)
      E=Max(E,N)
   Next 
   _DATUM[A] : A$=Param$
   _DATUM[E] : E$=Param$

'* Bildformate IFF/ABK 
   For I=0 To Length(1)-1
      N=Peek(Start(15)+I*90+70)
      If N=1
         Inc XIFF
      Else If N=2
         Inc XABK
      End If 
   Next 

'* Anzahl Bildschrimmodus ermitteln
   For I=0 To Length(1)-1
      N=Deek(Start(15)+I*90+71)
      If N=0
         Inc XL
      Else If N=$8000
         Inc XH
      Else If N=4
         Inc XLL
      Else If N=$8004
         Inc XHL
      End If 
   Next 

'* Anzahl gepackter Bilder ermitteln 
   For I=0 To Length(1)-1
      If Peek(Start(15)+I*90+81) Then Inc XP
   Next 




    _T[205,39,"Baseeintragungen.......:"+Str$(Length(1))+" Bild(er)",1,13]
    _T[205,49,"Bildformate in IFF.....:"+Str$(XIFF)+" Bild(er)",1,13]
    _T[205,59,"Bildformate in ABK.....:"+Str$(XABK)+" Bild(er)",1,13]
    _T[205,69,"Modus Lowres...........:"+Str$(XL)+" Bild(er)",1,13]
    _T[205,79,"Modus Hires............:"+Str$(XH)+" Bild(er)",1,13]
    _T[205,89,"Modus Lowres + Laced...:"+Str$(XLL)+" Bild(er)",1,13]
    _T[205,99,"Modus Hires + Laced....:"+Str$(XHL)+" Bild(er)",1,13]
   _T[205,109,"Anzahl gepackt.........:"+Str$(XP)+" Bild(er)",1,13]
   _T[205,119,"Gesamt Bytegröße.......:"+Str$(XG)+" Bytes",1,13]
   _T[205,129,"Bilderstellungszeitraum: "+A$+" bis "+E$,1,13]

   _WAIT

   _BILDINFORMATION

End Proc
Procedure _ZEIGEBASE

   If Length(1)=False Then _O["Ooops, keine Base installiert !"] : Pop Proc

   Wait 25

   Cls 0,4,16 To 636,198

   Screen Open 1,320,86,16,Lowres
   Screen Hide 

   Do 
      Inc N
      Exit If N>Length(1)
      Paste Bob 0,0,N
      Zoom 1,2,1,148,84 To 0,4+I2*42,16+I*26,46+I2*42,42+I*26
      Add I2,1,0 To 14
      If I2=False Then Inc I
   Loop 

   Screen Close 1

   _G[428,174,632,196,1,0]
   _G[430,175,630,195,0,1]
   _T[440,177,"Bild:",1,13]
   _T[440,186,"Name:",1,13]

   Ink 15,4
   I=True
   X Mouse=X Hard(36)
   Y Mouse=Y Hard(39)

   While Mouse Key+Asc(Inkey$)=False

      X=X Screen(X Mouse)
      Y=Y Screen(Y Mouse)

      If X>6 and X<631 and Y>16
         X=(X-6)/42
         Y=(Y-16)/26
         N=Y*15+X
         If N<100 and N<>I
            N$=Str$(N+1)-" " : N$=String$("0",3-Len(N$))+N$
            Text 486,183,N$
            N$=Peek$(Start(15)+N*90,17,Chr$(0))
            If N$="" : N$="---" : End If 
            N$=N$+String$(" ",17-Len(N$))
            Text 486,192,N$
            I=N
         End If 
      End If 

   Wend 

   Cls 0,4,16 To 636,198
   Ink 1 : Draw 3,16 To 5,16

   Dec XMEN
   _APBMASKE

End Proc
Procedure _BASELöSCHEN

   If Length(1)=False Then _O["Ooops, keine Base installiert !"] : Pop Proc

   _R["Alle installierten Daten wirklich","aus dem Systemspeicher löschen ?",0]
   If Param=False Then Pop Proc

   _CLEARALL

End Proc

Procedure _ZEIGEBILD

   N$=Fsel$("","","Bitte Bild zum Ansehen wählen...")
   
   _SHOWPIC[N$] : If Param=-2 Then Pop Proc
   
   If Param>False
      Hide 
      Screen Show 0
      X=128
      Y=42
      Do 
         _WAIT
         N=Param
         Exit If N>31 or N<False
         If N=28 : Rem * Rechts 
            Add X,16
         Else If N=29
            Add X,-16
         Else If N=30
            Add Y,-16
         Else If N=31
            Add Y,16
         End If 
         Screen Display 0,X,Y,,
      Loop 
      Show 
      Screen Close 0
   End If 
   
   Dec XMEN
   _APBSCREEN
   _APBMASKE
   
End Proc
Procedure _AUFNEHMEN
   
   '* Speicher für Bilddaten reservieren !? 
   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
   If Length(1)=False Then Reserve As Data 15,9000


   N$=Fsel$("","","Bitte Bild für Aufnahme wählen...")
   _SHOWPIC[N$] : If Param=-2 Then Pop Proc


   If Param>False

      '* Größe & Datum ermitteln 
      '~~~~~~~~~~~~~~~~~~~~~~~~~ 
      Reserve As Work 8,261
      N$=N$+Chr$(0)
      Dreg(1)=Varptr(N$)
      Dreg(2)=-2
      XLOCK=Doscall(-84)
      Dreg(1)=XLOCK
      Dreg(2)=Start(8)
      XEXAMINE=Doscall(-102)
      Dreg(1)=XLOCK
      XUNLOCK=Doscall(-90)
      XBILDGROESSE=Leek(Start(8)+124)
      XBILDDATUM=Leek(Start(8)+132)
      Erase 8

      
      XBILDTYP=Param
      
      If XAS20$="PP20"
         XBILDPACKER=1
      Else If XAS20$="AS20"
         XBILDPACKER=2
      End If 

      '* Message-Screen bereitstellen
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      Screen Display 0,,50,,
      Screen Show 0
      
      Screen Open 2,360,8,2,Hires
      Screen Display 2,208,41,,
      Colour 0,0
      Text 0,6,"Bitte warten, Bilddaten werden berechnet..."

      '* Bild in Datei aufnehmen 
      '~~~~~~~~~~~~~~~~~~~~~~~~~ 
      Hide 
      Screen 0
      X=150 : Y=85 : XF=Max(16,Screen Colour)
      Screen Open 1,160,Y+1,XF,Lowres
      Screen Hide 
      Flash Off 
      Cls 0
      Get Palette 0
      For I=0 To XF-1
         Colour I,Colour(I)-Colour(I) mod $111
      Next 
      
      Zoom 0,0,0,Screen Width(0),Screen Height(0) To 1,0,0,X,Y
      
      '* Farbpixels angleichen 
      '~~~~~~~~~~~~~~~~~~~~~~~ 
      Wait 100
      N=Execall(-132)
      For I=0 To X
         For I2=0 To Y
            Plot I,I2,Max(2,15-Min(14,Val(Mid$(Hex$(Colour(Point(I,I2))),1,2))))
         Next 
      Next 
      N=Execall(-138)
      
      Ink 15 : Box 0,0 To X-1,Y-1 : Box 1,0 To X-2,Y-1
      
      Get Bob 1,Length(1)+1,0,0 To X,Y
      Make Mask 

      '* Bildaten in Bank aufnehmen
      '~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      Screen 0
      S=Start(15)+(Length(1)-1)*90
      
      N$=Flip$(N$)
      N=Instr(N$,"/")
      If N=False
         N=Instr(N$,":")
      End If 
      Dec N
      
      Poke$ S,Flip$(Left$(N$,N))
      Poke$ S+33,Flip$(N$-Left$(N$,N))
      Loke S+66,XBILDDATUM
      Poke S+70,XBILDTYP
      Doke S+71,Screen Mode
      Doke S+73,Screen Width(0)
      Doke S+75,Screen Height(0)
      Loke S+77,Screen Colour
      Poke S+81,XBILDPACKER
      Loke S+86,XBILDGROESSE

      Screen 2
      Text 0,6,"Berechnungen beendet, bitte Taste drücken ! "
      Flash 1,"(000,3)(333,2)(555,2)(777,2)(999,2)(BBB,2)(FFF,14)(BBB,2)(777,2)(555,2)(333,2)"
      
      _WAIT
      
      Flash Off 
      Screen Close 2
      Screen Close 1
      
      N=Chip Free+Fast Free
      Screen Close 0
      Loke S+82,Chip Free+Fast Free-N
      
      Show 
      
      XBILD=Length(1)

   End If 



   Dec XMEN
   _APBSCREEN
   _APBMASKE
   
End Proc
Procedure _AUSTRAGEN

   If Length(1)=False Then _O["Ooops, keine Base installiert !"] : Pop Proc



   _R["Soll der Bildeintrag #"+Str$(XBILD)-" ","wirklich aus der Base entfernt werden ?",0]
   If Param=False Then Pop Proc



   Del Bob XBILD

   Copy Start(15)+XBILD*90,Start(15)+Length(15) To Start(15)+(XBILD-1)*90

   Fill Start(15)+8910 To Start(15)+9000,0



   If Length(1)

      Add XBILD,-1,1 To Length(1)
      _PUTBOB

      Cls 0,15,146 To 626,156
      N=620/Max(1,Length(1))
      _G[Min(Max(15,625-N),15+(XBILD-1)*N),147,Min(625,15+XBILD*N),155,0,1]

      _BILDINFORMATION

   Else 

      _CLEARALL

   End If 

End Proc
Procedure _LUPE

   If Length(1)=False Then _O["Ooops, keine Base installiert !"] : Pop Proc

   Wait 25

   Cls 0,7,16 To 636,198

   Screen Open 1,320,86,16,Lowres
   Screen Hide 

   Paste Bob 0,0,XBILD

   N=Execall(-132)
   Zoom 1,2,1,148,84 To 0,7,16,632,198
   N=Execall(-138)

   Screen Close 1

   _WAIT

   Cls 0,7,16 To 636,198

   Dec XMEN
   _APBMASKE

End Proc
Procedure _INFOEDITOR

   If Length(1)=False Then _O["Ooops, keine Base installiert !"] : Pop Proc

   S=Start(15)+(Max(1,XBILD)-1)*90

   N$=Peek$(S,33,Chr$(0))
   _I["Bildname:",N$]
   If Param$<>""
      N$=Left$(Param$,33)
      Poke$ S,N$+String$(Chr$(0),33-Len(N$))
      N$=N$+String$(" ",33-Len(N$))
   End If 
   Ink 15,0 : Text 357,45,N$

   N$=Peek$(S+33,33,Chr$(0))
   _I["Zugriffspfad:",N$]
   If Param$<>""
      N$=Left$(Param$,33)
      Poke$ S+33,N$+String$(Chr$(0),33-Len(N$))
      N$=N$+String$(" ",33-Len(N$))
   End If 
   Ink 15,0 : Text 357,55,N$

End Proc

Procedure _IFFZUABK

   N$=Fsel$("*.IFF","","Bitte zu wandelndes IFF Bild wählen...")

   _SHOWPIC[N$] : If Param=-2 Then Pop Proc

   If Param>False

      Screen Show 0

      N$=Fsel$("*.ABK","","Bitte ABK Bild zum speichern wählen...")


      If N$<>""

         Spack 0 To 16

         Repeat 
            N=False
            Trap Save N$,16
            If Errtrap
               _FEHLER[Errtrap]
               N=Param
            End If 
         Until N=False

         Erase 16

      End If 


      _WAIT

   End If 

   Dec XMEN
   _APBSCREEN
   _APBMASKE

End Proc
Procedure _ABKZUIFF

   N$=Fsel$("*.ABK","","Bitte zu wandelndes ABK Bild wählen...")

   _SHOWPIC[N$] : If Param=-2 Then Pop Proc

   If Param>False

      Screen Show 0

      N$=Fsel$("*.IFF","","Bitte IFF Bild für Speicherung wählen...")

      If N$<>""

         Repeat 
            N=False
            Trap Save Iff N$
            If Errtrap
               _FEHLER[Errtrap]
               N=Param
            End If 
         Until N=False

      End If 

      _WAIT

   End If 

   Dec XMEN
   _APBSCREEN
   _APBMASKE

End Proc
Procedure _SQUASH

   N$=Fsel$("","","Bitte Datei für Kompression auswählen...")

   If N$<>""

      Trap Open In 1,N$
      If Errtrap
         _FEHLER[Errtrap]
         Pop Proc
      End If 
      A$=Input$(1,4)
      L=Lof(1)
      Close 1

      If A$="AS20"
         _O[N$+" wurde bereits gepackt !"]
         Pop Proc
      End If 

      Trap Reserve As Work 16,L
      If Errtrap=False
         Bload N$,Start(16)
      Else 
         Erase 16
      End If 

      If Length(16)

         _O["Bitte warten, komprimiere "+N$+"..."]

         _AS20SQUASH[16,3]

         If Param>False

            _O[XAS20$]

            Repeat 
               Trap Bsave N$,Start(16) To Start(16)+Length(16)
               If Errtrap
                  _FEHLER[Errtrap]
                  N=Param
               End If 
            Until N=False

         Else If Param=0

            _O["Squashprozess abgebrochen !"]

         Else If Param<0

            _R[N$," konnte nicht komprimiert werden !",1]
            _O[""]

         End If 

      End If 

   End If 

End Proc
Procedure _UNSQUASH

   N$=Fsel$("","","Bitte Datei für Dekompression wählen...")

   If N$<>""

      Trap Open In 1,N$
      If Errtrap
         _FEHLER[Errtrap]
         Pop Proc
      End If 
      A$=Input$(1,4)
      L=Lof(1)
      Close 1

      If A$<>"AS20"
         _O[N$+" wurde noch nicht komprimiert !"]
         Pop Proc
      End If 

      Trap Reserve As Work 16,L
      If Errtrap
         _FEHLER[Errtrap]
         Pop Proc
      End If 

      Trap Bload N$,Start(16)
      If Errtrap
         _FEHLER[Errtrap]
         Pop Proc
      End If 

      _O["Bitte warten, entpacke Datei..."]
      _AS20UNSQUASH[16]

      If Param>0
         Bsave N$,Start(16) To Start(16)+Length(16)
         _O[XAS20$]
      Else If Param=-1
         _R[N$,"ist keine AS20 komprimierte Datei !",1]
      Else If Param=-2
         _R[N$,"konnte nicht entpackt werden !",1]
      Else If Param=-3
         _FEHLER[24]
      End If 

   End If 

End Proc
Procedure _DATEILöSCHEN

   N$=Fsel$("","","Bitte zu löschende Datei auswählen...")
   If N$<>""
      _R[N$,"wirklich löschen ?",0]
      If Param
         Repeat 
            Trap Kill N$
            If Errtrap
               _FEHLER[Errtrap]
               N=Param
               If N=81
                  N=False
               End If 
            End If 
         Until N=False
         If Errtrap=False
            _O["Datei "+N$+" wurde gelöscht !"]
         End If 
      End If 
   End If 

End Proc

Procedure _SYSTEMINFO

   '* Aktuelles Datum und Zeit ermitteln  
   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~  
   N$=Space$(12)
   Dreg(1)=Varptr(N$)
   Dreg(0)=Doscall(-192)

   M=Leek(Varptr(N$)+4)
   H=M/60
   M=M mod 60
   S=Leek(Varptr(N$)+8)/50
   H$=Str$(H)-" " : H$=String$("0",2-Len(H$))+H$
   M$=Str$(M)-" " : M$=String$("0",2-Len(M$))+M$
   S$=Str$(S)-" " : S$=String$("0",2-Len(S$))+S$

   _DATUM[Leek(Varptr(N$))] : A$="Datum:"+Param$+"  Zeit:"+H$+":"+M$+":"+S$
   B$="Chip:"+Str$(Chip Free)-" "+"  Fast:"+Str$(Fast Free)-" "+"  Gesamt:"+Str$(Chip Free+Fast Free)-" "
   _R[A$,B$,1]

End Proc
Procedure _SYSTEMTEST

   For I=1 To 6

      Read N$,N : _O["Teste "+N$+"..."] : Wait 20

      N=Leek(Leek(4)+N)

      If N
         _R["Vorsicht: "+N$+" ist abnorm !","Zeiger: "+Hex$(N,8),1]
         A=True
      End If 

   Next 

   If A=False Then _O["Keine abnormen Systemveränderrungen !"] Else _O[""]

   Data "ColdCapture",$2A
   Data "CoolCapture",$2E
   Data "WarmCapture",$32
   Data "KickMemPtr",$222
   Data "KickTagPtr",$226
   Data "KickCheckSum",$22A

End Proc
Procedure _SYSTEMRESET

   _R["Wirklich das komplette System","in den Kaltstart-Zustand versetzen ?",0]

   If Param

      '* Maschinenprogramm in 'N$' installieren  
      For I=1 To 88
         Read N
         N$=N$+Chr$(N)
      Next 

      '* ColdReset aufrufen  
      Call Varptr(N$)

   End If 

   '* Daten des Maschinenprogramm 'ColdReset' 
   Data 51,252,64,0,0,223,240,154,44,121,0,0,0,4,34,60,170,170
   Data 187,187,45,65,0,36,45,65,0,38,45,65,0,62,45,65,0,78
   Data 45,65,0,82,45,65,2,42,12,110,0,36,0,20,109,4,78,238
   Data 253,42,75,250,0,8,78,174,255,226,0,0,32,124,1,0,0,0
   Data 145,232,255,236,32,104,0,4,85,136,78,112,78,208,0,0

End Proc
Procedure _CLITASK

   N$="CON:0/0/640/200/ApbDOS » Keine Eingabe = Ende «"+Chr$(0)
   Dreg(1)=Varptr(N$)
   Dreg(2)=1006
   XHANDLE=Doscall(-30)


   If XHANDLE=False Then _R["CLI / Shell Task konnte","nicht eingerichtet werden !",1] : Pop Proc


   '* Ein bisch...schen Show muß sein ! 
   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
   N$="Copyright ©1994 Testaware, Inc."+Chr$(10)
   N$=N$+"All rights reserved."+Chr$(10)
   N$=N$+"Release 1.0a"+Chr$(10)
   Gosub _W

   Amos Lock 
   Amos To Back 
   Screen Close 0


   '* Buffer für `Read` 
   '~~~~~~~~~~~~~~~~~~~ 
   Reserve As Work 16,255


   Do 

      N$=Chr$(10)+"A> "
      Gosub _W
      Gosub _R
      Exit If _LVOREAD<2

      Dreg(1)=Start(16)
      Dreg(2)=False
      Dreg(3)=XHANDLE
      _LVOEXECUTE=Doscall(-222)

   Loop 


   Dreg(1)=XHANDLE
   _LVOCLOSE=Doscall(-36)

   Dec XMEN
   _APBSCREEN
   _APBMASKE

   Amos Unlock 
   Amos To Front 

   Pop Proc

_W:Dreg(1)=XHANDLE
   Dreg(2)=Varptr(N$)
   Dreg(3)=Len(N$)
   _LVOWRITE=Doscall(-48)
   Return 

_R:Dreg(1)=XHANDLE
   Dreg(2)=Start(16)
   Dreg(3)=Length(16)
   _LVOREAD=Doscall(-42)
   Return 

End Proc
Procedure _üBERAPB

   Cls 0,200,37 To 623,139
   Ink 15,0

   For I=0 To 10
      Read N$
      Text 412-Len(N$)*4,45+I*9,N$
   Next 

   If Length(1)
      _WAIT
      _BILDINFORMATION
   End If 

   Data "APicBase ist ein Shareware Programm !"
   Data "Programmiert in AMOSPro V2.0 & APCmp V2.0 !"

   Data ""

   Data "Bei regelmäßiger Benutzung bitte ich"
   Data "um einen kleinen Obulus von nur 10,- DM !"

   Data ""

   Data "Meine Adresse lautet:"
   Data "Volker Stepprath     "
   Data "Tegeler Str. 7       "
   Data "40789 Monheim        "
   Data "Deutschland          "

End Proc

Procedure _APBMASKE

   For I=1 To 12
      Read X,Y,XX,YY,S,M
      _G[X,Y,XX,YY,S,M]
   Next 

   N$="Bild" : _T[94-Len(N$)*4,23,N$,1,13]

   N$="Information" : _T[412-Len(N$)*4,23,N$,1,13]

   If Length(1)
      XBILD=Max(1,XBILD)
      _PUTBOB
      _BILDINFORMATION
      N=620/Max(1,Length(1))
      _G[Min(Max(15,625-N),15+(XBILD-1)*N),147,Min(625,15+XBILD*N),155,0,1]
   Else 
      _SLIDER
      _üBERAPB
   End If 

   _G[10,183,630,194,1,0]
   Cls 12,12,184 To 629,194
   _O[""]

   _MENU

'* Fenster für Bild  
   Data 10,19,180,127,1,0,12,20,178,126,0,0
   Data 12,20,178,33,0,1,12,34,178,126,0,0

'* Bereich für Nummer
   Data 10,126,180,141,1,0,12,127,178,140,0,0

'* Fenster für Bildinfo
   Data 190,19,630,141,1,0,192,20,628,140,0,0
   Data 192,20,628,33,0,1,192,34,628,140,0,0

'* Scrollbereich 
   Data 10,144,630,158,1,0,12,145,628,157,0,0

End Proc
Procedure _APBSCREEN

   Screen Open 0,640,200,16,Hires
   Flash Off 
   Curs Off 
   Cls 0
   Colour Back Colour(0)

   For I=1 To 8
      Read X,Y,XX,YY,S,M
      _G[X,Y,XX,YY,S,M]
   Next 

'* Close-Symbol
   Ink 12 : Box 12,5 To 18,10
   Cls 1,13,6 To 18,10

'* Iconify-Symbol
   Ink 12 : Box 615,4 To 627,9 : Box 620,6 To 632,11
   Cls 1,621,7 To 632,11

   N$="APicBase V1.0a ©1994 by Testaware, ®18-Nov-94 by Volker Stepprath"
   _T[320-Len(N$)*4,4,N$,1,13]

'* Hauptfenster
   Data 0,14,640,199,1,0,2,15,638,198,0,0
   Data 33,0,606,14,1,0,35,1,604,14,0,1

'* Gadgets 
   Data 0,0,32,14,1,0,2,1,30,14,0,1
   Data 607,0,640,14,1,0,609,1,638,14,0,1

End Proc
Procedure _AS20SQUASH[B,C]

   '* B = Banknummer die komprimiert werden soll
   '* C = Kompressionsdichte von 0 bis 3 (3=Best) 
   '* N = Parameter für Analyse N =0-Abbruch  <0-Fehler  >0-Banklänge 
   '* G = Orginalgröße der Bank   


   If B<3 and Length(B)=False

      N=-1 : Rem * Unerlaubte Banknummer (0-2) !

   Else 

      N=False
      Bset 8+C,N

      M=Timer

      N=Squash(Start(B),Length(B),-1,N,18)

      If N>0

         S=Timer-M
         S=S/50
         M=S/60
         H=M/60
         M=M mod 60
         S=S mod 60
         H$=Str$(H)-" " : H$=String$("0",2-Len(H$))+H$
         M$=Str$(M)-" " : M$=String$("0",2-Len(M$))+M$
         S$=Str$(S)-" " : S$=String$("0",2-Len(S$))+S$
         M$=H$+":"+M$+":"+S$

         P=Length(B)+8
         P=100-((100.0/P)*N)

         XAS20$="Squashrate:"+Str$(P)+"% ("+Str$(N)-" "+" von"+Str$(Length(B))+" Bytes) - Squashzeit: "+M$


         G=Length(B)

         Bank Shrink B To N

         Trap Reserve As Work 20,N+8
         If Errtrap=False

            '* AMOS Squash Erkennungs-Code eintragen 
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
            Poke$ Start(20),"AS20"


            '* Orginal Bankgröße übermitteln 
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
            Loke Start(20)+4,G


            '* Komprimierte Daten in Bank 16 übertragen
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            Copy Start(B),Start(B)+N To Start(20)+8


            Bank Swap B,20

            Erase 20

            N=Length(B)

         Else 

            N=-3 : Rem * Nicht genügend Systemspeicher verfügbar !

         End If 

      End If 

   End If 

End Proc[N]
Procedure _AS20UNSQUASH[B]

   If Leek(Start(B))<>$41533230

      N=-1 : Rem * Keine AS20 Bank

   Else 

      Trap Reserve As Chip Work 20,Leek(Start(B)+4)
      If Errtrap=False
         
         Copy Start(B)+8,Start(B)+Length(B) To Start(20)
         
         N=Unsquash(Start(20),Length(B)-8)

         XAS20$="Gepackte Größe:"+Str$(Length(B))+" - Entpackte Größe:"+Str$(Length(20))+" Bytes"
         
         Erase B
         
         Bank Swap 20,B
         
         Do 

            Read N$
            Exit If N$=""

            C=Hunt(Start(B) To Start(B)+24,N$)

            If C
               Copy Start(B)+20,Start(B)+Length(B) To Start(B)
               Bank Shrink B To Length(B)-20
               Poke$ Start(B)-8,N$+String$(" ",8-Len(N$))
               Exit 
            End If 
            
         Loop 
         
         
      Else 
         
         N=-3 : Rem * Nicht genügend Systemspeicher
         
      End If 
      
   End If 

   '* AmBk Codes
   Data "Pac.Pic."
   Data "Music"
   Data "Tracker"
   Data "Samples"
   Data ""

End Proc[N]
Procedure _BILDINFORMATION

   If Length(1)=False Then Pop Proc

   Cls 0,200,37 To 623,139

   XBILD=Max(1,XBILD)

   S=Start(15)+(XBILD-1)*90

   _DATUM[Leek(S+66)]

   Ink 15,0

   N$=Str$(XBILD)-" " : N$=String$("0",3-Len(N$))+N$
   Ink 15 : Text 82,136,N$ : Rem * Nummer 

   N$=Peek$(S,33,Chr$(0))
   _T[205,39,"Bildname.........:",1,13] : Ink 15 : Text 357,45,N$

   N$=Peek$(S+33,33,Chr$(0))
   _T[205,49,"Zugriffspfad.....:",1,13] : Ink 15 : Text 357,55,N$

   N$=Str$(Leek(S+86))-" "+" Bytes"
   _T[205,59,"Dateigröße.......:",1,13] : Ink 15 : Text 357,65,N$

   _T[205,69,"Erstellungsdatum.:",1,13] : Ink 15 : Text 357,75,Param$

   N=Peek(S+70)
   If N=1
      N$="IFF"
   Else If N=2
      N$="AMOS ABK"
   End If 
   _T[205,79,"Bildformat.......:",1,13] : Ink 15 : Text 357,85,N$

   N=Deek(S+71)
   If N=0
      N$="Lowres"
   Else If N=$8000
      N$="Hires"
   Else If N=4
      N$="Lowres + Laced"
   Else If N=$8004
      N$="Hires + Laced"
   End If 
   _T[205,89,"Bildschirmmodus..:",1,13] : Ink 15 : Text 357,95,N$

   N$=(Str$(Deek(S+73))+"x"+Str$(Deek(S+75)))-" "
   _T[205,99,"Größe in Pixel...:",1,13] : Ink 15 : Text 357,105,N$

   N=Leek(S+77)
   If N=2
      T=1
   Else If N=4
      T=2
   Else If N=8
      T=3
   Else If N=16
      T=4
   Else If N=32
      T=5
   Else If N>32
      T=6
   End If 
   N$=Str$(T)-" "+" ("+Str$(N)-" "+")"
   _T[205,109,"Farbtiefe........:",1,13] : Ink 15 : Text 357,115,N$

   N=Peek(S+81)
   If N=1
      N$="PowerPacker"
   Else If N=2
      N$="AMOS Squasher"
   Else 
      N$="-"
   End If 
   _T[205,119,"Packer...........:",1,13] : Ink 15 : Text 357,125,N$

   N$=Str$(Leek(S+82))-" "+" Bytes"
   _T[205,129,"Speicherverbrauch:",1,13] : Ink 15 : Text 357,135,N$

End Proc
Procedure _CLEARALL

   Bob Off 
   XBILD=False

   Trap Reserve As Data 15,1000000000
   Erase All 

   Ink 0,0 : Text 82,136,"   "

   N=620/Max(1,Length(1))
   _G[Min(Max(15,625-N),15+XBILD*N),147,Min(625,15+(XBILD+1)*N),155,0,1]

   _üBERAPB

   Wait 10

End Proc
Procedure _DATUM[D]
   
   Y=1978
   
   Do 
      If(Y-1 and 3)=0
         L=1
      Else 
         L=0
      End If 
      Exit If D<365+L
      Add D,-365-L
      Inc Y
   Loop 
   
   M=1
   For I=1 To 12
      Read N
      Exit If D<N
      Add D,-N
      Inc M
   Next 
   
   If D+1<=N
      Inc D
   End If 

   D$=Str$(Max(1,D))-" " : D$=String$("0",2-Len(D$))+D$
   M$=Str$(Max(1,M))-" " : M$=String$("0",2-Len(M$))+M$


   D$=D$+"-"+M$+"-"+Str$(Y)-" "
   
T: Data 31,28+L,31,30,31,30,31,31,30,31,30,31
   
End Proc[D$]
Procedure _ENDE

   _G[2,1,30,14,1,0]
   Wait 20

   _R["APicBase V1.0a","wirklich beenden ?",0]
   If Param
      Request On 
      End 
   End If 

   _G[2,1,30,14,0,0]

End Proc
Procedure _FEHLER[N]

   If N=24
      A$="Nicht genügend Systemspeicher verfügbar,"
      B$="Prozess vorzeitig beendet !"
      N=1

   Else If N=30
      A$="Datei ist kein IFF bzw. ABK Format,"
      B$="Prozess vorzeitig beendet !"
      N=1

   Else If N=81
      A$="Datei wurde nicht aufgefunden,"
      B$="Prozess vorzeitig beendet !"
      N=1

   Else If N=84
      A$="Diskette ist schreibgeschützt,"
      B$="erneuten Schreibversuch starten ?"
      N=0

   Else If N=86 or N=93
      A$="Datenträger nicht verfügbar,"
      B$="Prozess vorzeitig beendet !"
      N=1

   Else If N=88
      A$="Datenträger ist überfüllt,"
      B$="Schreibversuch vorzeitig beendet !"
      N=1

   Else If N=94
      A$="I/O Fehler aufgetreten,"
      B$="Bitte prüfen sie ihren Datenträger !"
      N=1

   Else If N=95
      A$="Datei ist keine AMOS(Pro) Bank,"
      B$="Ladeversuch vorzeitig beendet !"
      N=1

   Else 
      A$="AMOS(Pro) Fehler #"+Str$(N)-" "+" aufgetreten,"
      B$="Prozess vorzeitig beendet !"
      N=1

   End If 

   _R[A$,B$,N]

   If N=1 Then N=False Else N=Param

End Proc[N]
Procedure _G[X,Y,XX,YY,S,M]

   If M Then Ink 4 : Bar X+2,Y+1 To XX-2,YY-1

   If S=0 Then I=2 : I2=9 Else I=9 : I2=2

   Ink I : Draw X,Y To XX-2,Y : Draw X,Y To X,YY : Draw X+1,Y To X+1,YY-1

   Ink I2 : Draw X+2,YY To XX,YY : Draw XX-1,Y+1 To XX-1,YY : Draw XX,Y To XX,YY

   If S
      Ink 6 : Draw X+2,Y+1 To X+6,Y+1 : Plot XX,YY,1
   Else 
      Ink 1 : Draw X+2,Y+1 To X+4,Y+1 : Plot X+4,Y+1,2
   End If 

End Proc
Procedure _I[N$,A$]

   _O[""]

   Text 15,191,N$+" "+A$ : Ink ,4 : Text 23+Len(N$+A$)*8,191," "

   Repeat 

      Repeat : N=Asc(Inkey$) : Multi Wait : Until N

      If N>31 and N<123 and Len(A$+N$)<73 Then A$=A$+Chr$(N)
      If N=8 and Len(A$)>0 Then A$=Left$(A$,Len(A$)-1)

      Ink ,9 : Text 23+Len(N$)*8,191,A$+"  "
      Ink ,4 : Text 23+Len(N$+A$)*8,191," "

   Until N=13

   _O[""]

End Proc[A$]
Procedure _ICONIFY[N$]

   _G[609,1,638,14,1,0]
   Wait 20

   N$=N$+Chr$(0) : Rem -------- * Fenstertittel mit Nullbyte abschließen
   F$=String$(Chr$(0),48) : Rem * Speicher für Fensterdefinition 
   F=Varptr(F$) : Rem --------- * Adresse der Fensterdefinition

   Doke F,587-Len(N$)*8 : Rem - * X Position 
   Doke F+4,Len(N$)*8 : Rem --- * Breite 
   Doke F+6,10 : Rem ---------- * Höhe
   Poke F+8,2 : Rem ----------- * Schrift weiß 
   Poke F+9,3 : Rem ----------- * Hintergrund blau 
   Loke F+10,$500 : Rem ------- * IDCMP-Flags (RMB & ScanKey)
   Loke F+14,2 : Rem ---------- * Drag (nur verschieben)
   Loke F+26,Varptr(N$) : Rem - * Adresse des Titels für Fenster 
   Doke F+46,1 : Rem ---------- * Screentyp Workbench 

   Amos Lock : Rem ------------ * [Amiga]+[A] abschalten
   Amos To Back : Rem --------- * AMOS im Hintergrund

   Screen Close 0

   Areg(0)=F : Rem ------------ * Fensterdefintion nach A0
   F=Intcall(-204) : Rem ------ * Fenster öffnen

   Areg(0)=Leek(F+86) : Rem --- * Message-Port für Benutzer
   W=Execall(-384) : Rem ------ * Warten auf Nachricht

   Areg(0)=F : Rem ------------ * Fensterhandle nach A0 
   F=Intcall(-72) : Rem ------- * Fenster schließen

   Dec XMEN
   XBILD=False
   Proc _APBSCREEN
   Proc _APBMASKE

   Amos Unlock : Rem ---------- * [Amiga]+[A] anschalten
   Amos To Front : Rem -------- * AMOS im Vordergrund 

End Proc
Procedure _MENU

   Add XMEN,1,1 To 4

   Restore Str$(XMEN)-" "

'* Schalter
   Cls 12,10,163 To 631,179
   Cls 0,12,164 To 630,177

   For I=0 To 4

      Read N$,XSC$(I)

      _T[72+I*120-Len(N$)*4,167,N$,1,13]

      N=Instr(N$,XSC$(I))-1
      Ink 11 : Draw 70+I*120-Len(N$)*4+N*8,176 To 80+I*120-Len(N$)*4+N*8,176
      _G[12+I*120,164,131+I*120,177,0,0]

   Next 

   _G[613,164,628,177,0,1]
   Ink 13,4 : Text 616,173,Str$(XMEN)-" "

1 Data "BASE EINLADEN","L"
  Data "BASE SPEICHERN","S"
  Data "BASE INFO","I"
  Data "ZEIGE BASE","Z"
  Data "BASE LÖSCHEN","C"

2 Data "ZEIGE BILD","Z"
  Data "AUFNEHMEN","A"
  Data "AUSTRAGEN","N"
  Data "LUPE","L"
  Data "INFO EDITOR","E"

3 Data "IFF ZU ABK","I"
  Data "ABK ZU IFF","A"
  Data "SQUASH","S"
  Data "UNSQUASH","U"
  Data "DATEI LÖSCHEN","D"

4 Data "SYSTEM INFO","I"
  Data "SYSTEMTEST","T"
  Data "SYSTEM RESET","R"
  Data "CLI TASK","C"
  Data "ÜBER APICBASE","B"

End Proc
Procedure _O[N$]

   Cls 9,14,185 To 627,193
   Ink 1,9 : Text 320-Len(N$)*4,191,N$

End Proc
Procedure _PPAMBK[B,C]
   
   '* Testen ob PP20 Datenfile !? 
   If Leek(Start(B))<>$50503230 Then Goto _DECODE
   
   
   
   
   C=$80+C*2 : Rem * Flash-Farbe  
   
   
   
   
   '* ASM Programm in String einlesen 
   Restore _PP20
   For A=0 To 255 : Read N : N$=N$+Chr$(N) : Next 
   
   
   
   
   N=Length(B) : Rem * Länge der gepackten Datei  
   A=Start(B) : Rem  * Startadresse der Datei
   
   
   
   
   '* Länge der entpackten Datei ermitteln
   N=(Peek(A+N-4)*256+Peek(A+N-3))*256+Peek(A+N-2)
   
   
   
   
   '* Freie Bank für PPDecrunch bestimmen 
   For A=65535 To 1 Step -1
      
      If Length(A)=False
         
         Trap Reserve As Chip Work A,N
         If Errtrap
            Goto _DECODE
         End If 
         
         Exit 
         
      End If 
      
   Next 
   
   
   
   
   '* Daten in ASM String eintragen   
   Loke Varptr(N$)+2,Start(B)
   Loke Varptr(N$)+8,Length(B)
   Loke Varptr(N$)+14,Start(A)
   
   
   
   
   '* ASM String aufrufen & Bank entpacken
   Call Varptr(N$)
   
   
   
   
   '* Entpackte Daten in Bank installieren
   Bank Swap A,B
   
   
   
   
   '* Art der Bank ermitteln & angleichen 
   _DECODE:
   
   '* Datazeiger auf Codes
   Restore _AMBK
   
   Do 
      
      Read N$
      Exit If N$=""
      
      '* Suche nach Bankcode 
      C=Hunt(Start(B) To Start(B)+24,N$)
      
      '* Testen ob AMOSPro-Bank
      If C
         Copy Start(B)+20,Start(B)+Length(B) To Start(B)
         Bank Shrink B To Length(B)-20
         Poke$ Start(B)-8,N$+String$(" ",8-Len(N$))
         Exit 
      End If 
      
   Loop 
   
   
   
   
   '* Rückgabewert für Paramanalyse - ok=True 
   If N$="" Then N=False Else N=True
   
   
   
   
   '* Bank löschen
   Erase A
   
   
   
   
   '* ASM PP20 Programmdaten  
   _PP20: Data 65,249,0,0,0,0,32,60,0,0,0,0,67,249,0,0
   Data 0,0,97,0,0,4,78,117,12,144,80,80,50,48,102,0
   Data 0,88,71,232,0,4,65,240,8,0,36,73,124,3,126,7
   Data 122,1,34,74,34,32,74,1,103,0,0,10,97,0,0,60
   Data 83,1,226,173,224,137,213,193,97,0,0,48,101,0,0,84
   Data 116,0,112,1,97,0,0,52,212,65,178,70,103,0,255,244
   Data 112,7,97,0,0,38,21,1,51,202,0,223,241,C,81,202
   Data 255,240,179,202,101,0,0,44,78,117,226,141,103,0,0,4
   Data 78,117,42,32,226,149,78,117,83,64,114,0,226,141,103,0
   Data 0,10,227,145,81,200,255,246,78,117,42,32,226,149,96,0
   Data 255,242,112,1,97,0,255,228,112,0,16,51,16,0,52,1
   Data 180,70,102,0,0,36,97,0,255,194,101,0,0,4,112,7
   Data 97,0,255,198,54,1,112,2,97,0,255,192,212,65,178,71
   Data 103,0,255,244,96,0,0,8,97,0,255,174,54,1,82,66
   Data 21,50,48,0,51,202,0,223,241,C,81,202,255,244,179,202
   Data 101,0,255,86,78,117,0,0,0,0,0,0,0,0,0,0
   
   '* AmBk Codes
   _AMBK: Data "Pac.Pic."
   Data "Music"
   Data "Tracker"
   Data "Samples"
   Data ""
   
End Proc[N]
Procedure _PUTBOB

   Bob 1,19,38,XBILD
   Wait Vbl 

End Proc
Procedure _R[A$,B$,N]

   Screen Open 3,384,78,16,Hires
   Screen Hide 3
   Screen Display 3,192,105,,
   Curs Off 
   Flash Off 
   Colour 0,$0
   Colour 3,$FF0
   Cls 6

   _G[0,0,384,77,1,0]
   _G[2,1,382,76,0,0]
   _G[8,4,375,46,1,0]

   _G[8,57,78,72,1,0]
   _G[10,58,76,71,0,0]

   _G[305,57,375,72,1,0]
   _G[307,58,373,71,0,0]

   _T[192-Len(A$)*4,17,A$,3,13]
   _T[192-Len(B$)*4,27,B$,3,13]

   Restore "R"+Chr$(48+N)

   Read A$,B$
   _T[43-Len(A$)*4,61,A$,1,13]
   _T[340-Len(B$)*4,61,B$,1,13]

   Screen Show 3

   Do 

      _WAIT : N=Param

      If N<0
         X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
         If Y>57 and Y<72
            If X>9 and X<77
               N=27
            Else If X>306 and X<374
               N=13
            End If 
         End If 
      End If 

      If N=27 Then _G[10,58,76,71,1,0] : N=False : Exit 
      If N=13 Then _G[307,58,373,71,1,0] : N=True : Exit 

   Loop 

   Wait 15

   Clear Key 

   Screen Close 3

   R0: Data "Nein","Ja"
   R1: Data "Ok","Ok"

End Proc[N]
Procedure _SHOWPIC[N$]

   If N$<>""
      
      If Exist(N$)
         
         Trap Open In 1,N$
         Trap A$=Input$(1,4)
         Trap Close 1
         
         XAS20$=A$
         
      Else 
         
         _FEHLER[81]
         N=-2 : Rem * Datei nicht gefunden 
         
      End If 
      
   Else 
      
      N=-2 : Rem * Leerer String
      
   End If 
   
   
   
   '* Art des Ladevorganges bestimmen 
   '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
   If A$="FORM"
      
      Trap Load Iff N$,0
      N=1
      
   Else If A$="AmBk"
      
      Trap Load N$,16
      If Errtrap=False
         Unpack 16 To 0
         N=2
      End If 
      
   Else If A$="PP20" or A$="AS20"
      
      Open In 1,N$
      N=Lof(1)
      Reserve As Work 16,N
      Sload 1 To Start(16),N
      Close 1
      
      If A$="PP20"
         
         _PPAMBK[16,18]
         
      Else If A$="AS20"
         
         _AS20UNSQUASH[16]
         
      End If 
      
      If Peek$(Start(16)-8,7)="Pac.Pic"
         Unpack 16 To 0
         N=2
      Else If Peek$(Start(16),4)="FORM"
         Bsave "RAM:APB_PP.Iff",Start(16) To Start(16)+Length(16)
         Trap Load Iff "RAM:APB_PP.Iff",0
         Kill "RAM:APB_PP.Iff"
         N=1
      Else 
         _FEHLER[30]
         N=True
      End If 
      
   Else If A$<>""
      
      _FEHLER[30]
      N=-2
      
   End If 
   
   If Errtrap Then N=True
   If N>False Then Screen Hide 
   
End Proc[N]
Procedure _SLIDER
   
   L=620/Max(1,Length(1))
   
   XALT=-1 : Rem * immer X<>XALT
   
   While Mouse Key
      
      X=Min(Max(15,X Screen(X Mouse)-15),625)/L
      
      If X<>XALT

         Cls 0,15,146 To 626,156
         _G[Min(Max(15,625-L),15+X*L),147,Min(625,15+(X+1)*L),155,1,0]

         XALT=X

         If Length(1)
            Bob 1,19,38,X+1
            N$=Str$(X+1)-" " : N$=String$("0",3-Len(N$))+N$
            Ink 15,0 : Text 82,136,N$ : Rem * Nummer 
         End If 

      End If 
      
   Wend 
   
   _G[Min(Max(15,625-L),15+X*L),147,Min(625,15+(X+1)*L),155,0,1]
   
End Proc[X+1]
Procedure _T[X,Y,N$,F,B]

   Add Y,6

   Gr Writing 0

   Ink B : Text X+1,Y+1,N$

   Ink F : Text X,Y,N$

   Gr Writing 1

End Proc
Procedure _WAIT

   Wait 10
   Clear Key 

   Repeat 
      N=Asc(Upper$(Inkey$))
      Exit If N
      N=-Mouse Key
      Multi Wait 
   Until N

   Clear Key 

End Proc[N]