home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / modula2 / compiler / m2mmdemo / isinst / module / maskdemo.mod < prev    next >
Encoding:
Text File  |  1989-02-27  |  9.1 KB  |  272 lines
  1.  
  2. MODULE MaskDemo;
  3.   (*---------------------------------------------------------------------*)
  4.   (*                   M A S K - D R I V E R - D E M O                   *)
  5.   (*                           M 2 P R O L I B                           *)
  6.   (*  Copyright (C) 1987    Bühlmann Computer Software   CH-8636 WALD    *)
  7.   (*                     -- All Rights Reserved --                       *)
  8.   (*---------------------------------------------------------------------*)
  9.   (*  Author: X. Bühlmann                                                *)
  10.   (*                                                                     *)
  11.   (*  Version 1.0      Date: 28/09/88                                    *)
  12.   (*---------------------------------------------------------------------*)
  13.   IMPORT BIOS, HelpDriver, TextDriver, Windows, Screen, ScreenNum;
  14.   FROM SYSTEM IMPORT ADR, SIZE;
  15.   FROM ByteString IMPORT FillBytes;
  16.   FROM SystemDef IMPORT rColor, eColor;
  17.   (*[-CSYS
  18.   FROM WinSupport IMPORT StatuslineColor;
  19.   ]*)
  20.   FROM SpecSupport IMPORT MonitorType, eMonitorType;
  21.   FROM KeyDriver IMPORT FKeys, KeyBoard, eDirection, DirecOnOff;
  22.   FROM Keyboard IMPORT cFuncOff, cShiftOff, cAlternFunc, cCtrlFunc,
  23.       cFunc, cShiftFunc, eShiftBits, sShiftBits, KeyPressed, Key,
  24.       ShiftBits;
  25.   FROM MaskInterface IMPORT aField, eFieldType, MaskVar, ClearAllFields,
  26.       DefineFields, NumFieldPlace, MaskRead, MaskWrite;
  27.   FROM MaskDriver IMPORT MaskColor, DefineMaskField, CreateMask,
  28.       CloseMask;
  29.   FROM Mask IMPORT SetEditMode, bFieldNum, eEditMode, eInputMode,
  30.       rFieldDescrip, rMaskDescrip, ActivateMask, RestoreFields,
  31.       DefineField, DisplayInputMode, EditFields, EndMask, InputMode,
  32.       SetField, UserFunc, InitField;
  33.   FROM Screen IMPORT CursorType, InqMaxScrBound, InqScrColor,
  34.       ScrPutString, ScrWriteLn, SetCursorType;
  35.   FROM String IMPORT Move;
  36.   FROM NumConv IMPORT LongIntToStr;
  37.   FROM DateCalc IMPORT Date, aBtrvDate, aDateType, ReadDate, CountDate;
  38.   (*
  39.     *)
  40.   TYPE
  41.     (*[+JPI*)
  42.     REAL = LONGREAL;
  43.     (*]*)
  44.     rMaskTp =
  45.       RECORD
  46.         s1, s2 : ARRAY [0..50] OF CHAR;
  47.         c : CARDINAL;
  48.         i : INTEGER;
  49.         l : LONGINT;
  50.         r : REAL;
  51.         sysDate, Date : aDateType;
  52.         bDate : aBtrvDate;
  53.         days1, days2, days3 : LONGINT;
  54.       END;
  55.   VAR
  56.     maskVar : rMaskTp;
  57.     Ind, fields, CursorSave : CARDINAL;
  58.     Modified, EditMode : BOOLEAN;
  59.   (*-----------------------------------------------------------------------*)
  60.   PROCEDURE Funktion(w : eDirection; VAR W : eDirection): CARDINAL;
  61.     VAR
  62.       Ind, Ch : CARDINAL;
  63.       xWdw : Windows.tWindow;
  64.     BEGIN
  65.       CASE w OF
  66.       | F1 :
  67.         IF HelpDriver.CreateHelp('Msk-Demo.HLP',1) THEN
  68.         END;
  69.         Ch := 0;
  70.         W := not;
  71.       | F5 :
  72.         RestoreFields();
  73.         MaskRead();
  74.         IF TextDriver.CreateTxt('Demo.MSK',2,xWdw) THEN
  75.           WITH maskVar DO
  76.             Screen.SetCursor(20, 1);
  77.             Screen.ScrWriteString(s1);
  78.             Screen.SetCursor(20, 2);
  79.             Screen.ScrWriteString(s2);
  80.             Screen.SetCursor(20, 4);
  81.             ScreenNum.WriteCard(c, 10);
  82.             Screen.SetCursor(20, 5);
  83.             ScreenNum.WriteInt(i, 10);
  84.             Screen.SetCursor(20, 6);
  85.             ScreenNum.WriteLong(l, 10);
  86.             Screen.SetCursor(20, 7);
  87.             ScreenNum.WriteReal(r, 5, 5);
  88.             Screen.SetCursor(20, 9);
  89.             Screen.ScrWriteString(sysDate);
  90.             Screen.SetCursor(20, 10);
  91.             Screen.ScrWriteString(Date);
  92.           END;
  93.           REPEAT
  94.           UNTIL Key()#0;
  95.           Windows.DeleteWindow(xWdw);
  96.         END;
  97.         Ch := 0;
  98.         W := not;
  99.       | F10 :
  100.         IF EditMode THEN
  101.           EditMode := FALSE;
  102.           SetEditMode(2, noEdit);
  103.         ELSE
  104.           EditMode := TRUE;
  105.           SetEditMode(2, optional);
  106.         END;
  107.         Ch := 0;
  108.         W := not;
  109.       ELSE
  110.         Ch := 0;
  111.         W := w;
  112.       END;
  113.       RETURN Ch;
  114.     END Funktion;
  115.   PROCEDURE charOK(fieldNum : bFieldNum; VAR ch : CHAR): BOOLEAN;
  116.     BEGIN
  117.       CASE fieldNum OF
  118.       | 2 :
  119.         ch := CAP(ch);
  120.       ELSE
  121.       END;
  122.       RETURN TRUE;
  123.     END charOK;
  124.   (*-----------------------------------------------------------------------*)
  125.   PROCEDURE displayInputMode();
  126.     BEGIN
  127.       IF InputMode=overtype THEN
  128.         SetCursorType(CursorSave);
  129.       ELSE
  130.         SetCursorType(0DH);
  131.       END;
  132.     END displayInputMode;
  133.   (*-----------------------------------------------------------------------*)
  134.   PROCEDURE fieldOK(fieldNum : bFieldNum; VAR field : ARRAY OF CHAR): 
  135.       BOOLEAN;
  136.     VAR
  137.       xNum : ARRAY [0..20] OF CHAR;
  138.       xDate : aDateType;
  139.     BEGIN
  140.       IF (field[0]#0C) & NOT NumFieldPlace(fieldNum,field) THEN
  141.         RETURN FALSE;
  142.       ELSE
  143.         Move(field, xDate);
  144.         CASE fieldNum OF
  145.         | 9 :
  146.           IF CountDate(xDate,maskVar.days2) THEN
  147.             LongIntToStr(maskVar.days2, 10, xNum);
  148.             IF NumFieldPlace(10,xNum) THEN
  149.               SetField(10, xNum);
  150.             END;
  151.           END;
  152.         | 11 :
  153.           IF CountDate(xDate,maskVar.days3) THEN
  154.             LongIntToStr(maskVar.days3, 10, xNum);
  155.             IF NumFieldPlace(12,xNum) THEN
  156.               SetField(12, xNum);
  157.             END;
  158.           END;
  159.         ELSE
  160.         END;
  161.       END;
  162.       RETURN TRUE;
  163.     END fieldOK;
  164.   (*-----------------------------------------------------------------------*)
  165.   PROCEDURE getComment(fieldNum : bFieldNum; VAR comment : ARRAY OF 
  166.       CHAR);
  167.     BEGIN
  168.       Move('│ F1 Help │ F5 Mask-Dump │ F10 Edit-Mode Field 3│', comment);
  169.     END getComment;
  170.   (*-----------------------------------------------------------------------*)
  171.   PROCEDURE userFunc(fieldNum : bFieldNum; key : CARDINAL);
  172.     BEGIN
  173.     END userFunc;
  174.   (*-----------------------------------------------------------------------*)
  175.   PROCEDURE Colors();
  176.     BEGIN
  177.       CASE MonitorType OF
  178.       | color :
  179.         (*[-CSYS
  180.         StatuslineColor(black, green);
  181.         ]*)
  182.         MaskColor(black, white, ltWhite, white, ltWhite, blue);
  183.         TextDriver.TxtColor(black, white);
  184.       | mono :
  185.         (*[-CSYS
  186.         StatuslineColor(black, white);
  187.         ]*)
  188.         MaskColor(white, black, ltWhite, black, black, white);
  189.         TextDriver.TxtColor(black, white);
  190.       | spec :
  191.         (*[-CSYS
  192.         StatuslineColor(black, white);
  193.         ]*)
  194.         MaskColor(white, black, ltWhite, black, black, white);
  195.         TextDriver.TxtColor(black, white);
  196.       END;
  197.     END Colors;
  198.   PROCEDURE DefMaskFields();
  199.     BEGIN
  200.       ClearAllFields();
  201.       WITH maskVar DO
  202.         DefineFields(ADR(s1), SIZE(s1), Str, 0, 0);
  203.         DefineFields(ADR(s2), SIZE(s2), Str, 0, 0);
  204.         DefineFields(ADR(c), SIZE(c), Card, 0, 5);
  205.         DefineFields(ADR(i), SIZE(i), int, 5, 5);
  206.         DefineFields(ADR(l), SIZE(l), Long, 0, 10);
  207.         DefineFields(ADR(r), SIZE(r), Real, 5, 10);
  208.         DefineFields(ADR(sysDate), SIZE(sysDate), date, 0, 0);
  209.         DefineFields(ADR(days1), SIZE(days1), long, 10, 10);
  210.         DefineFields(ADR(Date), SIZE(Date), date, 0, 0);
  211.         DefineFields(ADR(days2), SIZE(days2), long, 10, 10);
  212.         DefineFields(ADR(bDate), SIZE(bDate), Bdate, 0, 0);
  213.         DefineFields(ADR(days3), SIZE(days3), long, 10, 10);
  214.       END;
  215.     END DefMaskFields;
  216.   PROCEDURE Copyright();
  217.     BEGIN
  218.       Screen.ClearScrBound();
  219.       Screen.ScrWriteLn();
  220.       Screen.ScrPutString(
  221.           '          M A S K - D R I V E R - D E M O    Version 1.0 ');
  222.       Screen.ScrWriteLn();
  223.       Screen.ScrPutString(
  224.           '                           1 9 8 8                 ');
  225.       Screen.ScrWriteLn();
  226.       Screen.ScrWriteLn();
  227.       Screen.ScrPutString(
  228.           '                         Copyright by           ');
  229.       Screen.ScrWriteLn();
  230.       Screen.ScrPutString(
  231.           '                 (c) Bühlmann Computer Software    ');
  232.       Screen.ScrWriteLn();
  233.       Screen.ScrPutString(
  234.           '                         CH-8636 Wald              ');
  235.       Screen.ScrWriteLn();
  236.     END Copyright;
  237.   BEGIN
  238.     Copyright();
  239.     DirecOnOff := TRUE;
  240.     FKeys := Funktion;
  241.     CursorSave := CursorType();
  242.     DisplayInputMode := displayInputMode;
  243.     Colors();
  244.     FillBytes(ADR(maskVar), SIZE(maskVar), 0C);
  245.     ReadDate();
  246.     maskVar.sysDate := Date;
  247.     IF CountDate(Date,maskVar.days1) THEN
  248.     END;
  249.     DefMaskFields();
  250.     MaskWrite();
  251.     IF CreateMask('Demo.MSK',1,fields) THEN
  252.       EditMode := TRUE;
  253.       (**)
  254.       DefineMaskField(50, MaskVar[1]);
  255.       DefineMaskField(50, MaskVar[2]);
  256.       DefineMaskField(5, MaskVar[3]);
  257.       DefineMaskField(6, MaskVar[4]);
  258.       DefineMaskField(10, MaskVar[5]);
  259.       DefineMaskField(10, MaskVar[6]);
  260.       DefineMaskField(10, MaskVar[7]);
  261.       DefineMaskField(10, MaskVar[8]);
  262.       DefineMaskField(10, MaskVar[9]);
  263.       DefineMaskField(10, MaskVar[10]);
  264.       DefineMaskField(10, MaskVar[11]);
  265.       DefineMaskField(10, MaskVar[12]);
  266.       (**)
  267.       Modified := EditFields(InitField,userFunc,charOK,fieldOK,
  268.           getComment);
  269.       CloseMask();
  270.     END;
  271.   END MaskDemo.
  272.