home *** CD-ROM | disk | FTP | other *** search
/ M.u.C.S. Disc 2000 / MUCS2000.iso / sigisoft / hex_list / hex1list.lst < prev    next >
File List  |  1987-04-21  |  5KB  |  169 lines

  1. ' ***************************************************************************
  2. ' * Hex_Lister              (c) 1989   by                                   *
  3. ' * Siegfried Hübner Obere Vorstadt 21  8812 Windsbach Tel.09871/9835       *
  4. ' ***************************************************************************
  5. If Gemdos(17)=Not -1
  6.   Alert 3,"Bitte Drucker einschalten !",1,"OK|Abbruch",D%
  7.   If D%=2
  8.     End
  9.   Endif
  10.   If D%=1 And Gemdos(17)=1
  11.     Goto Asf
  12.   Else
  13.     Run
  14.   Endif
  15. Endif
  16. Defmouse 3
  17. Lprint Chr$(24);
  18. Lprint Chr$(15);
  19. If Xbios(4)=0
  20.   Alert 3,"Monitor bitte auf|mitlere Auflösung umschalten",1,"Danke",D%
  21.   End
  22. Endif
  23. Dim Pd$(17)
  24. For I%=0 To 17
  25.   Read Pd$(I%)
  26. Next I%
  27. Menu Pd$()
  28. On Menu  Gosub Abfrage
  29. Do
  30.   On Menu
  31. Loop
  32. Procedure Abfrage
  33.   Menu Off
  34.   If Xbios(4)=1
  35.     A=2
  36.   Else
  37.     A=1
  38.   Endif
  39.   Cls
  40.   ' ****************************************
  41.   ' * Programende                          *
  42.   ' ****************************************
  43.   If Pd$(Menu(0))=" Programmende "
  44.     Menu Kill
  45.     Alert 0,"Wollen Sie das Programm|      verlassen ?",2,"Ja|Nein",D%
  46.     If D%=1
  47.       End
  48.     Endif
  49.     Defmouse 3
  50.     Menu Pd$()
  51.     On Menu  Gosub Abfrage
  52.   Endif
  53.   ' ****************************************
  54.   ' * Public Domain                        *
  55.   ' ****************************************
  56.   If Pd$(Menu(0))=" Public Domain "
  57.     Menu Kill
  58.     If Xbios(4)=2
  59.       Deftext 1,0,16,7
  60.     Else
  61.       Deftext 1,1,1,5
  62.     Endif
  63.     Print At(1,3);"Hallo Atari Freaks !!!!!!!!!!"
  64.     Print "============================="
  65.     Print At(1,5);"Dieses Programm ist frei kopierbar, solange es nicht verändert"
  66.     Print "oder verkauft wird."
  67.     Print At(1,8);"Wem das Programm gefällt, der kann mir ja mal schreiben."
  68.     Print At(1,10);"Verbesserungsvorschläge und Fehlerhinweise zu meinen"
  69.     Print At(1,11);"Programmen nehme ich gerne entgegen."
  70.     Print At(1,13);"Listing des Programmes in GFA Basic V2.0 auf Anfrage erhältlich."
  71.     Print At(1,15);"Meine Adresse:              Siegfried Hübner"
  72.     Print "                            Obere Vorstadt 21"
  73.     Print "                            8812 Windsbach"
  74.     Print At(1,20);"Schreibt doch bitte auch mal ein Public Domain Programm"
  75.     Print At(1,22);"Ich grü₧e auch alle Atari ST-Freaks ."
  76.     Menu Pd$()
  77.     On Menu  Gosub Abfrage
  78.   Endif
  79.   ' ***************************************
  80.   ' * Copyright                           *
  81.   ' ***************************************
  82.   If Pd$(Menu(0))=" Copyright"
  83.     Menu Kill
  84.     Alert 0,">>>>>>>>> Hex-Lister <<<<<<<<|(c) 1989 by Siegfried Hübner|            Obere Vorstadt 21|            8812 Windsbach",2,"Public|Domain|Programm",D%
  85.     Defmouse 3
  86.     Menu Pd$()
  87.     On Menu  Gosub Abfrage
  88.   Endif
  89.   ' *********************************
  90.   ' * Start                         *
  91.   ' *********************************
  92.   If Pd$(Menu(0))=" Lade/Drucke (Hex) "
  93.     Menu Kill
  94.     Hidem
  95.     Gosub Hex
  96.     Showm
  97.     Defmouse 3
  98.     Menu Pd$()
  99.     On Menu  Gosub Abfrage
  100.   Endif
  101. Return
  102. ' **************************
  103. ' * Datas einlesen         *
  104. ' **************************
  105. Data  , Copyright
  106. Data -------------------------
  107. Data 1,2,3,4,5,6,""
  108. Data Disk , Lade/Drucke (Hex) ,""
  109. Data Hilfe , Public Domain ,""
  110. Data Ende , Programmende ,""
  111. Procedure Hex
  112.   @Lade_text
  113. Return
  114. Procedure Lade_text
  115.   On Error Gosub Fehler
  116.   Cls
  117.   Gosub Intro_lade_text
  118.   Fileselect "*.*",Nam$,Nam$
  119.   Cls
  120.   Open "I",#1,Nam$
  121.   Print At(22,10);">>>>>>>>>> Bin am Drucken <<<<<<<<<<"
  122.   X=0.001
  123.   Lprint "    >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>    Hex-Listing des Programms ";Nam$;"    <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<    "
  124.   Lprint "    Zeile"
  125.   Lprint Using "#####.###",X;
  126.   Lprint "     ";
  127.   While Not Eof(#1)
  128.     A=Asc(Input$(1,#1))
  129.     Inc Z
  130.     Lprint Using "\.\",Hex$(A);
  131.     If Not Z=27
  132.       Lprint ",";
  133.     Endif
  134.     If Z=27
  135.       X=X+0.001
  136.       Lprint Chr$(10);
  137.       Lprint Using "#####.###",X;
  138.       Lprint "     ";
  139.       Z=0
  140.     Endif
  141.   Wend
  142.   Close #1
  143.   Z=0
  144.   X=0
  145.   Lprint Chr$(24);
  146.   Lprint Chr$(15);
  147.   Cls
  148. Return
  149. Procedure Intro_lade_text
  150.   If Xbios(4)<>2
  151.     Graphmode 1
  152.     Deffill 1,2,2
  153.     Pbox 157,0,482,26
  154.     Deftext 1,16,16,24
  155.     Graphmode 2
  156.     Text 160,23,"L a d e  -  T e x t"
  157.   Else
  158.     Graphmode 1
  159.     Deffill 1,2,2
  160.     Pbox 156,19,482,51
  161.     Deftext 1,16,16,32
  162.     Graphmode 2
  163.     Text 205,47," Lade - Text "
  164.   Endif
  165. Return
  166. Procedure Fehler
  167.   Run
  168. Return
  169.