home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1164 / inout.int < prev    next >
Encoding:
Text File  |  1994-02-15  |  12.4 KB  |  369 lines
  1. unit InOut;
  2.  
  3. { Version 4.2
  4.   (c) 1993 by
  5.       Jochen Göttler
  6.       Im Dellbrunnen 6
  7.       D-66954 Pirmasens
  8.       Tel: 06331/92788
  9.       Fax: 06331/93620
  10. }
  11.  
  12. {$A+,B-,D-,F-,I-,L-,O-,R-,S-,V-,X-}
  13.  
  14.  
  15. interface
  16.  
  17.  
  18. uses ASCII, Crt, Dos, Numeric;
  19.  
  20. const TxtBkFarbe:     Byte                   = Black;
  21.       ShortCutFarbe:  Byte                   = LightRed;
  22.       IOFarbe:        Byte                   = Yellow;
  23.       IOBkFarbe:      Byte                   = Blue;
  24.       DisableFarbe:   Byte                   = DarkGray;
  25.       DisableBkFarbe: Byte                   = TxtBkFarbe;
  26.       LinienFarbe:    Byte                   = Blue;
  27.       FileBkFarbe:    Byte                   = Blue;
  28.       FileFarbe:      Byte                   = LightCyan;
  29.       ButtonDelay:    Word                   = 300;
  30.       MotionDelay:    Word                   = 270;
  31.       DoubleDelay:    Byte                   = 18;
  32.               {
  33.               Verzögerung für Doppelklick
  34.               }
  35.       MouseButtonKey: Array[1..3] of Char    = (Enter,Esc,F10);
  36.       MouseButtonSpc: Array[1..3] of Boolean = (false,false,false);
  37.               {
  38.               Sonderzeichen?
  39.               }
  40.       MouseDbButtonKey: Array[1..3] of Char  = ('-','+','0');
  41.       MouseDbButtonSpc: Array[1..3] of Boolean = (false,false,false);
  42.       MouseMotionKey: Array[0..3,0..8] of Char =
  43.     ((Pos1,Hoch,BildHoch,Links,#0,Rechts,Ende,Runter,BildRunter),
  44.      ('7','8','9','4',#0,'6','1','2','3'),
  45.      (AltPos1,AltHoch,AltBildHoch,AltLinks,#0,
  46.       AltRechts,AltEnde,AltRunter,AltBildRunter),
  47.      (#0,'/',#0,'-',#0,'+',#0,'*',#0));
  48.               {
  49.               [0,j]:  keine Maustaste gedrückt
  50.               [1,j]:  linke Maustaste gedrückt
  51.               [2,j]:  mittlere Maustaste gedrückt
  52.               [3,j]:  rechte Maustaste gedrückt
  53.               j=0..8: links hoch, hoch, rechts hoch, links,
  54.                   [unbenzutzt], rechts, links runter,
  55.                   runter, rechts runter
  56.               }
  57.       MouseMotionSpc: Array[0..3,0..8] of Boolean =
  58.     ((true,true,true,true,false,true,true,true,true),
  59.      (false,false,false,false,false,false,false,false,false),
  60.      (true,true,true,true,false,true,true,true,true),
  61.      (false,false,false,false,false,false,false,false,false));
  62.       Quiet:          Boolean                = false;
  63.       Disable:        Boolean                = false;
  64.       EinfgStart:     Boolean                = false;
  65.       FKey:           Array[F1..F10] of Char = (#0,#0,#0,#0,#0,#0,#0,#0,#0,#0);
  66.       FKeyPressed:    Array[F1..F10] of Boolean = (false,false,false,false,
  67.                     false,false,false,false,false,false);
  68.       MaxItemNr                              = 16;
  69.       MaxItemLength                          = 20;
  70.       Ground:         Pointer                = Nil;
  71.               {
  72.               Bei geöffnetem Fenster <>Nil
  73.               }
  74.  
  75. type  RealTypes     = (Rat,RatPos,Expon,Auto);
  76.       ItemType      = Array[1..MaxItemNr] of String[MaxItemLength];
  77.  
  78. var   Quit, Special:                                      Boolean;
  79.       Cursor, DOSFarbe, WinLastColor, WinLastX, WinLastY: Byte;
  80.       VideoStart, LastWindMin, LastWindMax:               Word;
  81.       KlickTime:                                          LongInt;
  82.       Leer:                                               String;
  83.       {
  84.       255 Space
  85.       }
  86.  
  87. procedure IOF;
  88.       {
  89.       Setzt die InOut-Farbe
  90.       }
  91. procedure DAF;
  92.       {
  93.       Setzt Menü-Disable-Farbe; Disable:=TRUE
  94.       }
  95. procedure SetNormalCursor;
  96. procedure SetCursorOff;
  97.       {
  98.       (Default)
  99.       Globale Variable Cursor:
  100.       0= Cursor aus
  101.       1= Normaler Cursor
  102.       2= Voller Cursor
  103.       3= Rahmencursor
  104.       }
  105. procedure SetFullCursor;
  106. procedure SetBorderCursor;
  107. procedure SetCursor(Cursor: Byte);
  108. function  MouseLeft:   Boolean;
  109. function  MouseRight:  Boolean;
  110. function  MouseUp:     Boolean;
  111. function  MouseDown:   Boolean;
  112. function  MouseKey:    Char;
  113.       {
  114.       Liefert bei Mausbewegung die in MouseMotionKey, bei Drücken der
  115.       Maustasten die in MouseButtonKey definierten Tasten. War der
  116.       Mausstatus unverändert, wird Chr(0) zurückgegeben.
  117.       }
  118. function  MouseButton: Boolean;
  119. procedure Beep;
  120. procedure Beep2;
  121.       {
  122.       Bei Quiet=TRUE wird der Ton unterdrückt
  123.       }
  124. function  WindowX1:     Byte;
  125. function  WindowY1:     Byte;
  126. function  WindowX2:     Byte;
  127. function  WindowY2:     Byte;
  128. function  WindowWidth:  Byte;
  129. function  WindowHeight: Byte;
  130.       {
  131.       Liefert Einstellungen des momentanen Windows
  132.       }
  133. procedure Centre        (s: String);
  134. procedure CentreLn      (s: String);
  135. procedure ClrEolLn;
  136. procedure WriteClr      (s: String);
  137.       {
  138.       Löscht bis Zeilenende
  139.       }
  140. procedure WriteClrLn    (s: String);
  141. procedure WriteClrField (s: String; l: Byte);
  142. procedure WriteIO       (s: String; l: Byte; f: Boolean);
  143.       {
  144.       Ausgabe in IO-Farben bzw. Disable-Farben (Disable=TRUE)
  145.       l: Feldlänge
  146.       f: TRUE: rechtsbündig, FALSE: linksbündig
  147.       }
  148. procedure WriteAt       (x, y: Byte; s: String);
  149. procedure GoToXYC       (x, y: Byte);
  150.       {
  151.       Akzeptiert auch x>80 (Sprung in nächste Zeile
  152.       }
  153. procedure PutXYChar     (x, y: Byte; c: Char);
  154. procedure PutXYColor    (x, y, v, h: Byte);
  155. procedure PutXY         (x, y: Byte; c: Char; v, h: Byte);
  156. function  GetXYChar     (x, y: Byte): Char;
  157. function  GetXYColor    (x, y: Byte): Byte;
  158. procedure ColorBox      (x1, y1, x2, y2, v, h: Byte);
  159. procedure LightBox      (x1, y1, x2, y2: Byte);
  160. procedure DarkBox       (x1, y1, x2, y2: Byte);
  161. procedure InvertBox     (x1, y1, x2, y2: Byte);
  162. procedure CharBox       (x1, y1, x2, y2: Byte; c: Char);
  163. procedure Box           (x1, y1, x2, y2: Byte; c: Char; v, h: Byte);
  164. procedure ClrBox        (x1, y1, x2, y2: Byte);
  165. function  GetLine       (y, x1, x2: Byte): String;
  166.       {
  167.       Liefert momentanen Zeileninhalt am Bildschirm
  168.       }
  169. procedure TWrite        (s: String);
  170. procedure TWriteLn      (s: String);
  171.       {
  172.       Schreibt Text, ohne die Farben zu verändern
  173.       }
  174. procedure CWrite        (s: String; v, h: Byte);
  175. procedure CWriteLn      (s: String; v, h: Byte);
  176.       {
  177.       Schreibt Text mit Farben v und h
  178.       }
  179. procedure XLinie        (y, x1, x2, v, h: Byte; Doppelt: Boolean);
  180. procedure YLinie        (x, y1, y2, v, h: Byte; Doppelt: Boolean);
  181. procedure Linie;
  182.       {
  183.       waagrecht, 80 Zeichen lang, Linienfarbe
  184.       }
  185. procedure LinieKurz;
  186.       {
  187.       waagrecht, 79 Zeichen lang, Linienfarbe
  188.       }
  189. procedure GetWindow     (x1, y1, x2, y2: Byte; var WinObj: Pointer);
  190. procedure PutWindow     (var WinObj: Pointer);
  191. procedure DisposeWindow (var WinObj: Pointer);
  192. procedure OpenWindow    (x1, y1, x2, y2, v, h: Byte; Doppelt, Schatten:
  193.              Boolean; Titel: String; c: Byte);
  194.       {
  195.       x1:       Spalte linke obere Ecke
  196.       y1:       Zeile linke obere Ecke
  197.       x2:       Spalte rechte untere Ecke
  198.       y2:       Zeile rechte untere Ecke
  199.       v:        Vordergrundfarbe
  200.       h:        Hintergrundfarbe
  201.       Doppelt:  Doppelter Rahmen?
  202.       Schatten: Schattenwurf des Fensters?
  203.       Titel:    Überschrift in erster Zeile
  204.       c:        Farbe der Überschrift
  205.  
  206.       Der Text im Fenster kann max. x2-x1-2 Zeichen breit und y2-y1-2
  207.       Zeichen hoch sein.
  208.       }
  209. procedure CloseWindow(Restore: Boolean);
  210.       {
  211.       Restore: Hintergrund wiederherstellen?
  212.       }
  213. function  GetKey(CursorOn: Boolean): Char;
  214.       {
  215.       Die Funktion liest ein Zeichen vom Tastaturpuffer.
  216.       Falls eine Spezialtaste gedrückt wurde, wird der Sekundärcode des
  217.       Zeichens übergeben und die globale Variable "Special" auf TRUE ge-
  218.       setzt. Berücksichtigt auch Mausaktionen.
  219.       Im Fall CursorOn=TRUE erscheint dabei der Cursor.
  220.       }
  221. procedure JaNeinSchreiben (Antwort: Boolean);
  222. function  JaNeinLesen (Start: Boolean): Boolean;
  223.       {
  224.       Die Funktion realisiert eine Ja/Nein-Abfrage (Cursor on).
  225.       Der Programmbenutzer kann durch Drücken beliebiger Tasten zwischen
  226.       den Antworten "Ja" und "Nein" umschalten und mit Enter die gewählte
  227.       Antwort bestätigen. Alternativ kann "J" oder "N" gedrückt werden.
  228.       Esc ist gleichwertig mit "N".
  229.       Mit "Start" wird die Antwortvorgabe übermittelt, der Funktionswert
  230.       stellt die vom Benutzer gewählte Antwort dar (TRUE=Ja, FALSE=Nein).
  231.       }
  232. procedure JaNeinLesenE(var m: Boolean);
  233.       {
  234.       Wie JaNeinLesen, jedoch wird bei Esc der Wert von m wiederhergestellt.
  235.       }
  236. procedure AlternativeChoose(a1, a2: String; l: Byte; var m: Boolean);
  237.       {
  238.       Wahl zwischen Eingabealternativen a1 und a2
  239.       l: Feldlänge
  240.       }
  241. procedure WarteTaste(CursorOn: Boolean);
  242. procedure ItemChoose    (var ItemList: ItemType; l, n: Byte; var m: Byte);
  243.       {
  244.       ItemList: Array der Items
  245.       l:        Itemlänge
  246.       n:        ItemAnzahl
  247.       m:        Nr. des ausgewählten Items
  248.       }
  249. procedure InputString   (z: String; l: Byte; var e: String;
  250.              var Scroll: ShortInt);
  251.       {
  252.       z:      Alle bei der Eingabe zu akzeptierenden Zeichen
  253.           Sonderzeichen:
  254.           @l: Alle Kleinbuchstaben (ohne Umlaute)
  255.           @L: Alle Großbuchstaben (ohne Umlaute)
  256.           @g: Alle Klein- und Großbuchstaben mit
  257.               ßÇüéâäàåçêëèïîìÄÅÉæÆôöòûùÿÖÜ
  258.           @n: Alle Ziffern
  259.           @s: Sonderzeichen ^°!"²ⁿ$%&/([)]=?\'`#+*~<>|µ,;.:-_½¼πΣ√
  260.       l:      Länge der Eingabezeile
  261.       Scroll: <>0(=0): (Keine) Scrollabfrage
  262.  
  263.       Verfügbare Steuertasten:
  264.  
  265.       Links
  266.       Rechts
  267.       Hoch         (Falls Scroll<>0: Abbruch, Scroll=-2)
  268.       Runter       (Falls Scroll<>0: Abbruch, Scroll=2)
  269.       Zurück
  270.       Einfg
  271.       Entf
  272.       Pos1
  273.       Ende
  274.       StrgPos1     (Eingabezeile löschen)
  275.       StrgEnde     (Ab Cursorposition löschen)
  276.       Enter
  277.       Esc          (Eingabe abbrechen,
  278.             setzt globale Variable "Quit" auf TRUE)
  279.  
  280.       Funktionstasten werden berücksichtigt, ergeben in FKey[] definierte
  281.       Sonderzeichen oder führen zum Eingabeabbruch, falls FKey[i] gleich
  282.       der Funktionstaste selbst.
  283.  
  284.       Mausaktionen werden ebenfalls berücksichtigt.
  285.  
  286.       Falls EinfgStart (global) TRUE, ist zu Beginn Einfügemodus
  287.       eingeschaltet.
  288.       }
  289. procedure InputShortInt (l: Byte; f, Ein: Boolean; ug, og: ShortInt;
  290.              var e: ShortInt);
  291. procedure InputInteger  (l: Byte; f, Ein: Boolean; ug, og: Integer;
  292.              var e: Integer);
  293. procedure InputLongInt  (l: Byte; f, Ein: Boolean; ug, og: LongInt;
  294.              var e: LongInt);
  295. procedure InputByte     (l: Byte; f, Ein: Boolean; ug, og: Byte;
  296.              var e: Byte);
  297. procedure InputWord     (l: Byte; f, Ein: Boolean; ug, og: Word;
  298.              var e: Word);
  299. procedure InputReal     (t: RealTypes; l,d: Byte; f, Ein: Boolean;
  300.              ug, og: Real; var e: Real);
  301.       {
  302.       l:            Länge
  303.       d:            Dezimalstellen
  304.       f:            Rechtsbündig?
  305.       ug, og:       Unter- und Obergrenze
  306.             ug>=og: keine Grenzen
  307.       Ein:          Grenzen einschließlich?
  308.       }
  309. procedure ShortCutsAnzeigen(s, ShortCuts, ShortCutPos: String; x: Byte);
  310. procedure MenuChoose    (s, ShortCuts, ShortCutPos: String; x: Byte;
  311.              var y: ShortInt; Zeile, Next: Boolean;
  312.              var Scroll, Edit: ShortInt);
  313.       {
  314.       s:           Chr-Codes der Menüzeilennummern
  315.       ShortCuts:   Short-Cuts der Menüwahlpunkte
  316.       ShortCutPos: Chr-Codes der Short-Cut-Positionen
  317.       x:           Spalte der linken oberen Menüecke
  318.       y:           Nummer oder Position der aktuellen Zeile
  319.                (abh. von 'Zeile')
  320.       Zeile:       Zeilenangabe durch Nummer oder Position?
  321.       Next:        'y' bei jedem Aufruf auf nächste Zeile setzen?
  322.       Scroll:      <>0 (=0): (keine) Scrollabfrage
  323.       Edit:        <>0 (=0): (keine) Abfrage auf Einfg/Entf
  324.  
  325.       Tastenfunktionen:
  326.  
  327.       Runter:     Eine Zeile nach unten
  328.               In letzter Zeile bei Scroll<>0: Abbruch, Scroll:=2
  329.       Hoch:       Eine Zeile nach oben
  330.               In erster Zeile bei Scroll<>0: Abbruch, Scroll:=-2
  331.       BildRunter: Bei Scroll<>0: Abbruch, Scroll:=4
  332.       BildHoch:   Bei Scroll<>0: Abbruch, Scroll:=-4
  333.       Pos1:       Erste Zeile
  334.       Ende:       Letzte Zeile
  335.       Einfg:      Bei Edit<>0: Abbruch, Edit=2
  336.       Entf:       Bei Edit<>0: Abbruch, Edit=-2
  337.       Enter:      Zeile anwählen, Modus 1
  338.       Space:      Zeile anwählen, Modus 2 (y<0)
  339.       Esc:        Eingabe abbrechen,
  340.               setzt globale Variablen "Quit" auf TRUE
  341.  
  342.       Mausaktionen werden berücksichtigt.
  343.       }
  344. procedure FileChoose (x1, y1, x2, y2: Byte;
  345.               FileSpec: String; var FileStr: DirStr;
  346.               Show, Save: Boolean);
  347.       {
  348.       x1,...,y2: Fenstergröße
  349.       FileSpec:  Filter für die Fileanzeige
  350.       FileStr:   Datei mit Pfad
  351.       Show:      =true: Inhaltsverzeichnis wird angezeigt, keine Auswahl
  352.       Save:      =true: Dateiauswahl zum Speichern (keine Existenzprüfung)
  353.  
  354.       Die Auswahl kann mit Esc abgebrochen werden, wodurch "Quit" auf TRUE
  355.       gesetzt wird.
  356.       }
  357. function  TimeParam: LongInt;
  358.       {
  359.       TimeParam:=((h*60+m)*60+s)*100+hs
  360.       }
  361. procedure CloseInOut;
  362.       {
  363.       Setzt Fensterkoordinaten zurück, stellt Cursor mit vor Aufruf von
  364.       InOut gültigen Farben wieder her und löscht den Bildschirm
  365.       }
  366.  
  367.  
  368. end.
  369.