home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / praxis / rcmess.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-12-13  |  8.3 KB  |  271 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      RCMess.PAS                        *)
  3. (*         Widerstände und Kondensatoren messen           *)
  4. (*                  mit dem IBM-Gameport                  *)
  5. (*                                                        *)
  6. (*       (c) 1991 by Andreas Bartels  &  toolbox          *)
  7. (* ------------------------------------------------------ *)
  8. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V- }
  9.  
  10. PROGRAM Widerstaende_und_Kondensatoren_Messen;
  11. (* ---- (c) Andreas Bartels o7.12.199o ---- *)
  12.  
  13. Uses Crt, Dos;
  14.  
  15. CONST
  16.   MaxZaehler  = 10000;
  17.   PortNr      = $201;
  18.  
  19.   Einheit        : ARRAY[ 0.. 1] OF CHAR = ( 'Ω', 'F' );
  20.   DezimalVorsatz : ARRAY[-6.. 6] OF CHAR = 'afpnµm KMGTPE';
  21.   (* atto,femto,piko,nano,mikro,milli,
  22.     -,Kilo,Mega,Giga,Terra,Peta,Exa  *)
  23.  
  24.   MessBereichZahl  = 8;
  25.   MessBereichsKonstante : ARRAY[ 0..15] OF REAL =
  26.   ( (* 0    : C   für Eichung   : *)
  27.             100e-9,
  28.     (* 1- 7 : C's für R-Mesung  : *)
  29.             1e-3, 100e-6, 10e-6, 1e-6, 100e-9, 10e-9, 1e-9,
  30.     (* 8    : R   für Eichung   : *)
  31.             100e+3,
  32.     (* 9-15 : R's für C-Messung : *)
  33.             10e+6, 1e+6, 100e+3, 10e+3, 1e+3, 100, 10 );
  34.  
  35. VAR
  36.   Eichen           : BOOLEAN;
  37.   MessBereichNr,
  38.   MessModus        : BYTE;
  39.   EichFaktor,
  40.   MessFaktor       : REAL;
  41.   Ch               : CHAR;
  42.  
  43.  
  44. PROCEDURE CursorOn;
  45. BEGIN
  46.   INLINE($B4/$01/
  47.          $B9/13/12/   (* Cursoranf. 12.Z, Cursorende 13.Z *)
  48.          $CD/$10);
  49. END; (* CursorOn *)
  50.  
  51.  
  52. PROCEDURE CursorOff;
  53. BEGIN
  54.   INLINE($B4/$01/
  55.          $B9/$FF/$FF/       (* Cursoranfang und -ende auf *)
  56.          $CD/$10);        (* 255 setzen löscht den Cursor *)
  57. END; (* CursorOff *)
  58.  
  59.  
  60. FUNCTION GamePortRCProdukt : WORD;
  61. (* Fragt das R*C-Produkt des 3.Gameport-kanals ab *)
  62. VAR
  63.   IMR21, IMRA1,
  64.   GamePortByte : BYTE;
  65.   w, Zaehler   : INTEGER;
  66.  
  67. BEGIN  (* GamePortRCProdukt *)
  68. (* Erlaubte Interrupts speichern und verbieten *)
  69.   IMR21 := Port[$21];
  70.   IMRA1 := Port[$A1];
  71.   Port[$21]:= $FF;
  72.   Port[$A1]:= $FF;
  73.  
  74. (* Initialisierung *)
  75.   w := 0;
  76.   REPEAT
  77.     GamePortByte := Port[ PortNr ];
  78.     Inc( w );
  79.   UNTIL ((GamePortByte AND 12) = 0) OR (w > 100);
  80.   Port[PortNr] := GamePortByte;
  81.  
  82. (* Zähl-Routine zur Messung der Timer-Zeit *)
  83.   Zaehler := 0;
  84.   REPEAT
  85.     GamePortByte := Port[PortNr];
  86.     Inc(Zaehler); (* ... AND 1/2/4/8 für Kanäle 1/2/3/4 *)
  87.   UNTIL (GamePortByte AND 1 = 0) Or (Zaehler >= MaxZaehler);
  88.   GamePortRCProdukt := Zaehler;
  89.  
  90. (* Interrupts wieder zulassen *)
  91.   Port[$21]:= IMR21;
  92.   Port[$A1]:= IMRA1;
  93. END; (* GamePortRCProdukt *)
  94.  
  95.  
  96. FUNCTION MitDezimalVorsatz( Ausgabe : REAL ) : STRING;
  97. VAR
  98.   Dezimal    : SHORTINT;
  99.   AusgabeStr : STRING[7]; (*z.B. 123.4µ*)
  100.  
  101. BEGIN
  102.   Dezimal := 0;
  103.   WHILE Ausgabe >= 1000 DO BEGIN
  104.     Ausgabe := Ausgabe / 1000;
  105.     INC( Dezimal );
  106.   END; (* While, Ausgabe >= 1000 *)
  107.   WHILE Ausgabe < 1 DO BEGIN
  108.     Ausgabe := Ausgabe * 1000;
  109.     DEC( Dezimal );
  110.   END; (* While, Ausgabe < 1 *)
  111.   Str( Ausgabe:7:3, AusgabeStr );
  112.   MitDezimalVorsatz :=   AusgabeStr + ' '
  113.                        + DezimalVorsatz[Dezimal];
  114. END; (* MitDezimalVorsatz *)
  115.  
  116.  
  117. PROCEDURE Eichung;
  118. VAR
  119.   EichRCProdukt : REAL;
  120.  
  121. BEGIN
  122.   EichRCProdukt := ( GamePortRCProdukt + GamePortRCProdukt
  123.               + GamePortRCProdukt + GamePortRCProdukt) / 4;
  124.   EichFaktor := MessBereichsKonstante[ 0 ]
  125.               * MessBereichsKonstante[ MessBereichZahl ]
  126.               / EichRCProdukt;
  127.   GoToXY( 4,17 );
  128.   Write( ' R*C(Eichung) : ', EichRCProdukt:4:0, '  ' );
  129. END; (* Eichung *)
  130.  
  131.  
  132. PROCEDURE MessBereich;
  133. BEGIN
  134.   MessFaktor :=  EichFaktor
  135.         / MessBereichskonstante[MessBereichZahl*MessModus
  136.         + MessBereichNr];
  137.   GoToXY( 21,11 );
  138.   Write( MessBereichNr:1 );
  139.   GoToXY( 29,11 );
  140.   Write( MitDezimalVorsatz(    1      * MessFaktor):5,
  141.                             Einheit[MessModus] );
  142.   GoToXY( 46,13 );
  143.   Write( MitDezimalVorsatz(   1/2     * MessFaktor):5,
  144.                             Einheit[MessModus] );
  145.   GoToXY( 46,11 );
  146.   Write( MitDezimalVorsatz( MaxZaehler * MessFaktor):5,
  147.                             Einheit[MessModus] );
  148.   GoToXY( 26,17 );
  149.   IF MessModus = 0 THEN
  150.      Write('Referenzkondensator : ',
  151.             MitDezimalVorsatz( MessBereichsKonstante[
  152.                                MessBereichNr]), 'F ' )
  153.   ELSE
  154.      Write('Referenzwiderstand  : ',
  155.             MitDezimalVorsatz( MessBereichsKonstante[
  156.                    MessBereichZahl + MessBereichNr]), 'Ω' );
  157. END; (* MessBereich *)
  158.  
  159.  
  160. PROCEDURE Messung( MessBereichNr, MessModus : BYTE );
  161. VAR
  162.   Ausgabe    : REAL;
  163.   AusgabeStr : STRING[10]; (*z.B. 123.456 µF*)
  164.  
  165. BEGIN
  166.   IF Eichen THEN BEGIN
  167.    Eichung;
  168.    Messbereich;
  169.   END;
  170.   Ausgabe := ( GamePortRCProdukt + GamePortRCProdukt +
  171.                GamePortRCProdukt + GamePortRCProdukt ) / 4;
  172.   GoToXY( 17,13 );
  173.   Write( Ausgabe:5:0 );
  174.   Ausgabe := Ausgabe * MessFaktor;
  175.   IF Ausgabe > 0 THEN
  176.     AusgabeStr :=   MitDezimalVorsatz( Ausgabe )
  177.                   + Einheit[MessModus]
  178.   ELSE BEGIN
  179.     Sound( 440 );
  180.     AusgabeStr := 'Zu klein !';
  181.     Delay( 100 );
  182.     NoSound;
  183.   END; (* ELSE *)
  184.   GoToXY( 29,13 );
  185.   Write( AusgabeStr );
  186.   Sound(1000);
  187.   Delay(1);
  188.   NoSound;
  189. END; (* Messung *)
  190.  
  191.  
  192. BEGIN (* ---------------- Hauptprogramm ----------------- *)
  193.   ClrScr;
  194.   Window( 9,1, 70,21 );
  195.   CursorOff;
  196.   Write( '╒═════════════════════════════════════'+
  197.                        '══════════════════════╕ ');
  198.   Write( '│                                     '+
  199.                        '                      │ ');
  200.   Write( '│  Widerstands- und Kapazitätsmessung '+
  201.                        'mit dem IBM-Gameport  │ ');
  202.   Write( '│  RCMess  Version 1.0     '      +
  203.             ' (c) toolbox  &  A.Bartels 1990  │ ');
  204.   Write( '│                                '+
  205.                   '                           │ ');
  206.   Write( '│    Befehle :     < R >-Messung '+
  207.                   '  < +/- > Messbereich      │ ');
  208.   Write( '│                  < C >-Messung '+
  209.                   '  < Esc > Abbrechen        │ ');
  210.   Write( '│                  < E >ichung   '+
  211.                   '                           │ ');
  212.   Write( '╞════════════════════════════════'+
  213.                   '═══════════════════════════╡ ');
  214.   Write( '│                                '+
  215.                   '                           │ ');
  216.   Write( '│     Messbereich (   ) :        '+
  217.                   '       bis                 │ ');
  218.   Write( '│                                '+
  219.                   '                           │ ');
  220.   Write( '│     Messwert (      ) :        '+
  221.                   '       +/-                 │ ');
  222.   Write( '│                                '+
  223.                   '                           │ ');
  224.   Write( '╞════════════════════════════════'+
  225.                   '═══════════════════════════╡ ');
  226.   Write( '│                                '+
  227.                   '                           │ ');
  228.   Write( '│  Bitte Eich-R und Eich-C anschließen '+
  229.                         'und Taste drücken !  │ ');
  230.   Write( '│                                      '+
  231.                         '                     │ ');
  232.   Write( '╘══════════════════════════════════════'+
  233.                         '═════════════════════╛ ');
  234.   Ch            := ReadKey;
  235.   MessBereichNr := 5;
  236.   MessModus     := 0;
  237.   Eichen        := true;
  238.   REPEAT
  239.     Messung( MessBereichNr, MessModus );
  240.     IF Eichen = true THEN Eichen := false;
  241.     IF KeyPressed THEN BEGIN
  242.        Ch := ReadKey;
  243.        CASE Ch OF
  244.          'R', 'r' : BEGIN
  245.                       MessModus := 0;
  246.                       MessBereich;
  247.                     END;
  248.          'C', 'c' : BEGIN
  249.                       MessModus := 1;
  250.                       MessBereich;
  251.                     END;
  252.          'E', 'e' : Eichen := true;
  253.          '+'      : BEGIN
  254.                       IF MessBereichNr < 7 THEN
  255.                          Inc( MessBereichNr );
  256.                       MessBereich;
  257.                     END;
  258.          '-'      : BEGIN
  259.                       IF MessBereichNr > 1 THEN
  260.                          Dec( MessBereichNr );
  261.                       MessBereich;
  262.                     END;
  263.        ELSE END;
  264.     END; (* IF, Keypressed *)
  265.   Until Ch = #27;
  266.   CursorOn;
  267. END. (* RCMess.PAS *)
  268.  
  269. (* ------------------------------------------------------- *)
  270. (*                  Ende von RCMESS.PAS                    *)
  271.