DECLARE FUNCTION Ziffer% (Byte1%, Byte2%)
DECLARE FUNCTION Wert! (in%())
DECLARE FUNCTION Bereich$ (in%())
DECLARE FUNCTION Einheit$ (in%())
DECLARE FUNCTION Info$ (in%())

'-- dt9062.bas ------------------------------------------------- >>fst'01<< -
' - Das Programm holt Messwerte vom Digital-Multimeter Digitek DT-9062
'   ueber die serielle Schnittstelle (COM 1, COM 2) und zeigt sie an.
' - Der Messwert steht als Fliesskomma-Wert zur Verfuegung.
' - Damit steht der weiteren Verarbeitung der Messwerte nichts mehr im Wege.
' - Weitere Infos zum DT-9062: http://www.FrankSteinberg.de/hardmess.htm
' - PUBLIC DOMAIN
'-- V 20031020 ------------------------------- http://www.FrankSteinberg.de -


CLS
PRINT "Digitek DT-9062 DMM auslesen                    ENDE = [Esc]        >>fst'01<<"
PRINT "Nummer der seriellen Schnittstelle eingeben [1] oder [2] ";
Taste$ = INPUT$(1)
LOCATE 1, 36

'Schnittstelle zum Lesen oeffnen;
' - 2400 Baud, keine Paritaetspruefung, 8 Datenbits, 1 Stoppbit
' - keine Auswertung der Steuerleitungen
IF Taste$ = "2" THEN
 PRINT "COM 2"
 OPEN "COM2:2400,N,8,1,RS,CS,DS,CD" FOR INPUT AS #1
ELSE
 PRINT "COM 1"
 OPEN "COM1:2400,N,8,1,RS,CS,DS,CD" FOR INPUT AS #1
END IF

VIEW PRINT 2 TO 24: CLS                 'Kopfzeile fixieren

DIM in%(1 TO 14)                        'Datenfeld fuer 14 Bytes einrichten
                                        '(das DMM sendet 14 Bytes je Messung)

DO                                      'Hauptschleife

 DO                                     'Zeichen abwarten
  IF INKEY$ = CHR$(27) THEN END         'Abbruch mit [Esc]
 LOOP UNTIL LOC(1)

 DO                                     'pruefen, ob erstes empfangenes Byte
  in$ = INPUT$(1, #1)                   'wirklich Byte 1 ist
  in%(1) = ASC(in$)                     'Ascii-Wert des Zeichens
  Test% = in%(1) \ 16                   'hoeherwertiges Nibble isolieren
  IF INKEY$ = CHR$(27) THEN END         'Abbruch mit [Esc]
 LOOP UNTIL Test% = 1                   'wiederholen, wenn nicht Byte 1

 FOR i% = 2 TO 14                       'Byte 2 - 14 holen
  in$ = INPUT$(1, #1)
  in%(i%) = ASC(in$)                    'Ascii-Wert des Zeichens
 NEXT

 PRINT Bereich$(in%());
 PRINT USING "#####.### "; Wert!(in%());
 PRINT Einheit$(in%()); Info$(in%())

LOOP UNTIL INKEY$ = CHR$(27)            'naechsten Messwert oder Abbruch

CLOSE #1
END

FUNCTION Bereich$ (in%())              'Erzeugt einen String des Messbereichs

Bereich$ = "   "                       'wenn kein Bit gesetzt, 3 Leerzeichen
IF in%(1) AND 4 THEN Bereich$ = "DC "  'Byte1, Bit3
IF in%(1) AND 8 THEN Bereich$ = "AC "  'Byte1, Bit4

END FUNCTION

FUNCTION Einheit$ (in%())             'Erzeugt einen String der Mess-Einheit

IF in%(10) AND 2 THEN E1$ = "K"       'Byte10, Bit2
IF in%(10) AND 4 THEN E1$ = "n"       'Byte10, Bit3
IF in%(10) AND 8 THEN E1$ = "æ"       'Byte10, Bit4
IF in%(11) AND 2 THEN E1$ = "M"       'Byte11, Bit2
IF in%(11) AND 4 THEN E1$ = "%"       'Byte11, Bit3
IF in%(11) AND 8 THEN E1$ = "m"       'Byte11, Bit4

IF in%(12) AND 2 THEN E2$ = "Delta "  'Byte12, Bit2
IF in%(12) AND 4 THEN E2$ = "Ohm   "  'Byte12, Bit3
IF in%(12) AND 8 THEN E2$ = "Farad "  'Byte12, Bit4
IF in%(13) AND 2 THEN E2$ = "Hertz "  'Byte13, Bit2
IF in%(13) AND 4 THEN E2$ = "Volt  "  'Byte13, Bit3
IF in%(13) AND 8 THEN E2$ = "Ampere"  'Byte13, Bit4
IF in%(14) AND 2 THEN E2$ = "HFE   "  'Byte14, Bit2
IF in%(14) AND 4 THEN E2$ = "øC    "  'Byte14, Bit3

Einheit$ = E1$ + E2$                  'Teilstrings zusammensetzen

END FUNCTION

FUNCTION Info$ (in%())                       'Erzeugt einen String mit den
                                             'sonstigen Angaben
IF in%(1) AND 1 THEN Tmp$ = " RS232"         'Byte1, Bit1
IF in%(1) AND 2 THEN Tmp$ = Tmp$ + " Auto"   'Byte1, Bit2
IF in%(10) AND 1 THEN Tmp$ = Tmp$ + " Dio"   'Byte10, Bit1
IF in%(11) AND 1 THEN Tmp$ = Tmp$ + " Ton"   'Byte11, Bit1
IF in%(12) AND 1 THEN Tmp$ = Tmp$ + " Hold"  'Byte12, Bit1
IF in%(13) AND 1 THEN Tmp$ = Tmp$ + " Batt"  'Byte13, Bit1

Info$ = Tmp$                                 'Alle Angaben zusammensetzen

END FUNCTION

FUNCTION Wert! (in%())
'Erzeugt aus 4 Bytepaaren mit Hilfe der FUNCTION Ziffer% 4 Ziffern und
'wertet Komma- und Vorzeichenbits aus. Ergebnis ist eine Realzahl, die
'den Messwert enthaelt

 'Erste Ziffer  (Byte2, Bit1-3; Byte3, Bit1-4):
 Zahl% = Zahl% + Ziffer%(in%(2), in%(3)) * 1000
 'Zweite Ziffer (Byte4, Bit1-3; Byte5, Bit1-4):
 Zahl% = Zahl% + Ziffer%(in%(4), in%(5)) * 100
 'Dritte Ziffer (Byte6, Bit1-3; Byte7, Bit1-4):
 Zahl% = Zahl% + Ziffer%(in%(6), in%(7)) * 10
 'Vierte Ziffer (Byte8, Bit1-3; Byte9, Bit1-4):
 Zahl% = Zahl% + Ziffer%(in%(8), in%(9))

 'Vorzeichen (Byte2, Bit4):
 IF in%(2) AND 8 THEN Vorz% = -1 ELSE Vorz% = 1
 'Kommastelle:
 Div% = 1                          'wenn kein Komma, sonst...
 IF in%(8) AND 8 THEN Div% = 10    'Komma zwischen Ziffer 3+4 (Byte8, Bit4)
 IF in%(6) AND 8 THEN Div% = 100   'Komma zwischen Ziffer 2+3 (Byte6, Bit4)
 IF in%(4) AND 8 THEN Div% = 1000  'Komma zwischen Ziffer 1+2 (Byte4, Bit4)

 Wert! = Zahl% / Div% * Vorz%      'Messwert errechnen

END FUNCTION

FUNCTION Ziffer% (Byte1%, Byte2%)
'Erzeugt aus 3 niederwertigen Bits vom ersten Byte und 4 niederwertigen Bits
'vom zweiten Byte einen 7-Bit-Wert, der einer Ziffer zugeordnet wird.

 DreiBit% = Byte1% MOD 8               'obere 5 Bit loeschen
 VierBit% = Byte2% MOD 16              'obere 4 Bit loeschen
 SiebenBit% = DreiBit% + VierBit% * 8  '7 Bit Wert erzeugen
                             
                             '   Sieben-Segment-Anzeige
                             '
                             '            Bit0(1)
SELECT CASE SiebenBit%       '     
 CASE 40: Ziffer% = 1        '           XXX 1 XXX
 CASE 93: Ziffer% = 2        '          X         X
 CASE 121: Ziffer% = 3       ' Bit1(2)  6         2  Bit3(8)
 CASE 58: Ziffer% = 4        '          X   Bit4  X
 CASE 115: Ziffer% = 5       '           XXX 7 XXX
 CASE 119: Ziffer% = 6       '          X   (16)  X
 CASE 41: Ziffer% = 7        ' Bit2(4)  5         3  Bit5(32)
 CASE 127: Ziffer% = 8       '          X         X
 CASE 123: Ziffer% = 9       '           XXX 4 XXX
 CASE ELSE: Ziffer% = 0      '       
END SELECT                   '            Bit6(64)
                                                
END FUNCTION