home *** CD-ROM | disk | FTP | other *** search
/ Fifty: Elektronik / FIFTY Elektronik (PS_Computer_Vertrieb).iso / ps8 / fty1017 / gepackt.exe / DISK2 / PLOTSRC.EXE / KEYSCRN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-10  |  6.9 KB  |  214 lines
  1. {$R-,B-,V-}
  2. Unit KEYSCRN;
  3.  
  4. Interface
  5.  
  6. Uses Dos,Crt,StrTool;
  7.  
  8.  
  9. CONST IsColor : BOOLEAN = TRUE;
  10.       ModeCO80: Boolean = true;
  11.       ErrWinCol   :Byte =Crt.White+16*Crt.Red;
  12.       ErrHeadCol  :Byte =Crt.Yellow+16*Crt.Red;
  13.       Auto_ClrInp :Boolean=true;
  14.       Maus_Ratio  :Byte=10;
  15.        
  16.  
  17. TYPE
  18.      TypeSchirmbyte = RECORD CASE BYTE OF      { zur bequemeren  }
  19.                            1 : (Ch : CHAR;     { Verwaltung }
  20.                                 At : BYTE);
  21.                            2 : (W  : INTEGER);
  22.                         END;
  23.  
  24.      WordArray      = ARRAY [0..1999] OF TypeSchirmbyte; { zur Windowdarstellung  }
  25.      WordPtr        = ^ WordArray;                       { Windowinhalt }
  26.      WindowType     = RECORD
  27.                             Inhalt,Save  : WordPtr;   { Vorder- und Hintergrund }
  28.                             X1,Y1        : BYTE;      { Linke obere Ecke }
  29.                             Width,Height : BYTE;      { Größe des Windows }
  30.                             Size         : INTEGER;   { Größe in Bytes }
  31.                             Saved        : BOOLEAN;   { Hintergrund gesichert ? }
  32.                         END;
  33.      HotKeyType    =Record
  34.                        Key:Char;
  35.                        P  :Byte;
  36.                      end;
  37.       MenueType     = RECORD
  38.                             Picture     : WindowType; { Normales Window }
  39.                             Items,Color,              { Menüpunkte, Farbe }
  40.                             Pcolor      : BYTE;       { Zeigerfarbe }
  41.                             HiColor     : Byte;       { Farbe des HotKeys}
  42.                             LastSel     : Byte;
  43.                             HotKeys     : array[1..20] of HotKeyType;
  44.                         END;
  45.       MenueTextArray = ARRAY [1..20] OF Str80; { bis 20 Zeilen pro Menü }
  46.       MenueTextPtr   = ^ MenueTextArray;                { zur bequemeren Vernichtung }
  47.  
  48.  
  49. Const FuellChar :Char ='_';
  50.       Overwrite :Boolean=true;
  51.       EditForeground:Byte=White;
  52.       Editbackground:Byte=Red;
  53.       Mouse_Left :Char=^Q;
  54.       Mouse_Mid  :Char=Esc;
  55.       Mouse_Right:Char=^M;
  56.  
  57.  
  58.      (* Menge der möglichen Terminierungszeichen einer Eingabe *)
  59.  
  60. Var OutString :Str80;
  61.     CursorInital:Word;
  62.  
  63. Type Helpscreen=Array[1..15] of Str64;
  64.      HelpF  =File of Helpscreen;
  65.  
  66. Const ActualHelp   :Integer=0;
  67.       Helpfilename ='GEDDY.HLP';
  68.       Helpavailable: Boolean= True;
  69.       MaxHelpNr    : Integer =-1;
  70.  
  71. Function CalcAttr(fore,back:Byte):Byte;
  72.  
  73. PROCEDURE MakeWindow (VAR Slide                 : WindowType;  { Window erstellen }
  74.                           Xo,Yo,Breite,Hoehe,At : BYTE;
  75.                       VAR Ok                    : INTEGER);
  76.  
  77. PROCEDURE GetWindow (VAR Slide              : WindowType; { Window vom }
  78.                          Xo,Yo,Breite,Hoehe : BYTE;       { Bildschirm lesen  }
  79.                      VAR Ok                 : INTEGER);
  80.  
  81. PROCEDURE PutWindow (VAR Slide : Windowtype;  { Window anzeigen und Hintergrund }
  82.                      VAR Ok    : INTEGER);    { sichern }
  83.  
  84. PROCEDURE ShowWindow (VAR Slide : Windowtype); { Anzeigen ohne sichern des }
  85.  
  86. PROCEDURE MoveWindow ( VAR Slide  : WindowType;  { Window von der aktuellen }
  87.                            X,Y    : BYTE;        { an neue Position bringen. }
  88.                        VAR Ok     : INTEGER);    { und anzeigen }
  89.  
  90. PROCEDURE DeleteWindow ( VAR Slide : WindowType );  { Windowspeicher freigeben }
  91.  
  92. PROCEDURE RestoreWindow ( VAR Slide : WindowType; { Hintergrund restaurieren }
  93.                           VAR Ok    : INTEGER);
  94.  
  95. PROCEDURE WriteToWindow (VAR Slide  : WindowType;  { Beschriftung von Windows }
  96.                              X,Y,At : BYTE;
  97.                              Zeile  : Str80);
  98.  
  99. PROCEDURE MakeFrame (VAR Slide  : WindowType;      { Windows Einrahmen }
  100.                          At,Typ : BYTE);
  101.  
  102. PROCEDURE MakeMenue (VAR Menu          : MenueType;  { MAC Menü erstellen }
  103.                          Xo,Yo,Breite,               { Window mit Rahmen }
  104.                          Hoehe,Punkte,               { und Angabe der }
  105.                          Farbe,Balken,
  106.                          KeyCol        : BYTE;       { Auswahlmöglichkeiten }
  107.                          MenueText     : MenueTextPtr;
  108.                      VAR Ok            : INTEGER);
  109.  
  110. PROCEDURE FlipLine (X,Y,At,Len : INTEGER); { Zeile auf Bildschirm umfärben }
  111.  
  112. FUNCTION GetKey(Term:Charset):Char;    { Eine Taste lesen }
  113.  
  114. FUNCTION GetMenueChoice ( VAR Menu : MenueType;         { Menü anzeigen und }
  115.                           VAR Ok   : INTEGER   ):BYTE;  { Auswahl lesen }
  116.  
  117. PROCEDURE DisplayString (X,Y,At:BYTE; S:Str80); { Direkt auf den Bildschirm }
  118.  
  119. PROCEDURE DisplayInteger (X,Y,At:BYTE; Z:INTEGER; L:BYTE; Left:BOOLEAN);
  120.  
  121. PROCEDURE DisplayReal (X,Y,At:BYTE; Z:REAL; L,K:INTEGER; Left:BOOLEAN);
  122.  
  123. Procedure FullScreen;
  124.  
  125. Procedure SetEditColors(Tfore,tback,Efore,Eback:Byte);
  126.  
  127. Procedure SaveColors;
  128.  
  129. Procedure RestoreColors;
  130.  
  131. Procedure SaveCrtWindow;
  132.  
  133. Procedure RestoreCrtWindow;
  134.  
  135. PROCEDURE SetCursor (C:Word);       { Cursorform setzen }
  136.  
  137. PROCEDURE GetCursor (VAR C:Word);   { Cursorform lesen }
  138.  
  139. PROCEDURE FlushKbd;                 { Löscht den Tastaturpuffer }
  140.  
  141. Procedure Beep;
  142.  
  143. Procedure Dohelp;
  144.  
  145. Function  Keypressed:Boolean;
  146.  
  147. Procedure ResetMouseDelta;
  148.  
  149. Function ReadKbd(Var Ch:Char):Integer;
  150.  
  151. Procedure InputKbd(var S     : Str80;      (*Eingabestring*)
  152.                        L,X,Y : Integer;    (* L= max. Länge,XY=Schirmpos.*)
  153.                        Term  : CharSet;    (* Menge der Terminierungszeichen*)
  154.                        OkSet : CharSet;    (* zulässige Eingabezeichen *)
  155.                    var TC    : Char    );  (* Terminierungszeichen*)
  156.  
  157. Function LeseInt(I, L,X,Y,Min,Max :Integer;Var TC  :Char): Integer;
  158.  
  159. Function Cardinal(X:Integer):Real;
  160.  
  161. Procedure RealStr(X:Real;L: Integer; Var S :Str80);
  162.  
  163. Function LeseReal(Zahl:Real; L,X,Y :Integer;Min,Max :Real ;
  164.                   Var TC  :Char): Real;
  165.  
  166. Procedure Select(    Prompt : Str80;
  167.                      Term   : CharSet;
  168.                  var TC     : Char    );
  169.  
  170. Function Menueende(Var L :Integer;Max,Genug :Integer;TC :Char) :Boolean;
  171.  
  172. Procedure LeseFname(Var S :Str10;X,Y :Integer;Var TC:Char);
  173.  
  174. Procedure WaitonKey;
  175.  
  176. Function SelectError(Msg,Head:Str80;OkSet:Charset):Char;
  177.  
  178. Procedure  Message(Msg:Str80);
  179.  
  180.  
  181. implementation
  182.  
  183. (*$I WINDOWS.IMP *)
  184. (*$I INPUT.IMP   *)
  185.  
  186. Var ExitSave :Pointer;
  187.  
  188. {$F+} Procedure Myexit;{$F-}
  189. begin
  190.   Crt.Normvideo;
  191.   SetCursor(CursorInital);
  192.   ExitProc:=ExitSave;
  193. end;
  194.  
  195. begin
  196.   ExitSave:=ExitProc;
  197.   ExitProc:=@Myexit;
  198.   Iscolormonitor;
  199.   If Not ModeCO80 then
  200.   begin
  201.     Editbackground:=black;
  202.     ErrWinCol:=CalcAttr(Crt.white,Crt.black);
  203.     ErrHeadCol:=CalcAttr(lightgray,Crt.black);
  204.     DiaWinCol:=CalcAttr(lightgray,Crt.black);
  205.     DiaHeadCol:=CalcAttr(Crt.White,Crt.black);
  206.   end;
  207.   GetCursor(CursorInital);
  208.   SetCursor($2020);
  209.   MausInit;
  210.   Crea_Help;
  211.   CheckBreak:=false;
  212. end.
  213.  
  214.