home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 22 / saa / dbxitems.pas next >
Encoding:
Pascal/Delphi Source File  |  1991-01-04  |  40.6 KB  |  1,415 lines
  1. (* ----------------------------------------------------- *)
  2. (*                      DBXITEMS.PAS                     *)
  3. (*                                                       *)
  4. (* ■ RadioBut: Active wird durch Chr(7) gekennzeichnet,  *)
  5. (*   da immer Element einer Gruppe, gibt es nur Unter-   *)
  6. (*   schied aktiv-passiv.                                *)
  7. (* ■ PushBut: Immer alleine; sein Zustand (On/Off) lässt *)
  8. (*   mit Space umschalten, gekennzeichnet durch "X".     *)
  9. (* ■ EndBut: Hat einen Direktwahlcode zusätzlich (z.B.   *)
  10. (*   Enter für "Ok"-Endbutton. Bei seiner Wahl liefert er*)
  11. (*   den ReturnCode "ItFinish".                          *)
  12. (* ■ StringField: Besteht aus zwei Feldern: Namensfeld   *)
  13. (*   (von SAAItem) und dem Eingabefeld, in dem der String*)
  14. (*   bearbeitet wird, dieses ist scrollbar etc.          *)
  15. (* ■ Integer/RealField: Ändern "StringField" dahingehend,*)
  16. (*   dass nur Zahlen eingegeben werden können und dass   *)
  17. (*   der String am Ende umgewandelt wird.                *)
  18. (* ■ PickList: Lässt Benutzer in einem einfachen Fenster *)
  19. (*   ein Element auswählen, hat vertikalen Scrollbalken. *)
  20. (* ■ ExtPickList: Zusätzlich einen horizontalen Scroll-  *)
  21. (*   balken; also brauchen, wenn Länge der Einträge nicht*)
  22. (*   (wie z.B. bei FileList) von vornherein bestimmt ist.*)
  23. (* ■ StandAlonePickList: Fenster vom Typ "SAAWindow", das*)
  24. (*   von "ActiveStandWin" erbt, dh, bewegen und          *)
  25. (*   schliessen mit Maus möglich (ReturnCode=ItFinish,   *)
  26. (*   keine Wahl stattgefunden).                          *)
  27. (*                                                       *)
  28. (*           (c) 1991 by R.Reichert & toolbox            *)
  29. (* ----------------------------------------------------- *)
  30. UNIT DBxItems;
  31.  
  32. INTERFACE
  33.  
  34. USES Stuff,    UBase,   UMouse, MouKey, Lists,
  35.      WinVSM,   SB,
  36.      FrameWin, ActStWi, SAAWin, SAAItemD;
  37.  
  38. CONST                                      { ReturnCodes: }
  39.   ItOk            = 0; { Alles in Ordnung                 }
  40.   ItEvNotMine     = 1; { Event passt mir nicht            }
  41.   ItEvAccepted    = 2; { Event angenommen, => weitermachen}
  42.   ItFinish        = 3; { beenden, Abbruch                 }
  43.   ItSelected      = 4; { wurde gewählt                    }
  44.                        { hier nochmal, damit deswegen
  45.                          nicht immer SAAItemD zusätzlich
  46.                          geladen werden muss.             }
  47.  
  48.   ItActPrev      = 10; { aktiviere nächsten Item          }
  49.   ItActNext      = 11; { aktiviere vorhergehenden Item    }
  50.   ResultInvalid  = 12; { ungültiges Ergebnis (Integer/
  51.                          RealField                        }
  52.   ActiveBarColor : BYTE = 7;   { Aktiver Picklist-Eintrag }
  53.   EndButActColor : BYTE = $7F; { Aktive Endbutton-Farbe   }
  54.  
  55. TYPE
  56.   RadioButPtr = ^RadioBut;
  57.   RadioBut =OBJECT (SAAItem)
  58.  
  59.     CONSTRUCTOR Init (nx, ny : BYTE;
  60.                       N      : STRING;
  61.                       AltHKC : WORD;
  62.                       NewVSM : WExtVSMPtr);
  63.     PROCEDURE Display;                             VIRTUAL;
  64.     PROCEDURE SetActive;                           VIRTUAL;
  65.     PROCEDURE SetPassive;                          VIRTUAL;
  66.     PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
  67.   END;
  68.  
  69.   PushButPtr = ^PushBut;
  70.   PushBut =OBJECT (SAAItem)
  71.  
  72.     SaveFl, On : BOOLEAN;
  73.  
  74.     CONSTRUCTOR Init (nx, ny : BYTE;
  75.                       N      : STRING;
  76.                       AltHKC : WORD;
  77.                       NOn    : BOOLEAN;
  78.                       NewVSM : WExtVSMPtr);
  79.     PROCEDURE Display;                             VIRTUAL;
  80.     PROCEDURE SetActive;                           VIRTUAL;
  81.     PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
  82.     PROCEDURE SaveConfiguration;                   VIRTUAL;
  83.     PROCEDURE RestoreConfiguration;                VIRTUAL;
  84.     FUNCTION GetState : BOOLEAN;                   VIRTUAL;
  85.   END;
  86.  
  87.   EndButPtr = ^EndBut;
  88.   EndBut =OBJECT (SAAItem)
  89.  
  90.     ActCol : BYTE;
  91.     HotKeyCode : WORD;
  92.  
  93.     CONSTRUCTOR Init (nx, ny : BYTE;
  94.                       N      : STRING;
  95.                       AltHKC : WORD;
  96.                       NewHK  : WORD;
  97.                       NewVSM : WExtVSMPtr);
  98.     PROCEDURE SetColors (NC, NHKC, NAC : BYTE);
  99.     PROCEDURE SetActive;                           VIRTUAL;
  100.     PROCEDURE SetPassive;                          VIRTUAL;
  101.     PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
  102.   END;
  103.  
  104.   StringFieldPtr = ^StringField;
  105.   StringField = OBJECT (SAAItem)
  106.  
  107.     InsState  : BOOLEAN;
  108.     sx, sy    : BYTE;
  109.     FillChr   : CHAR;
  110.     FLength,
  111.     BegCol,
  112.     EndCol,
  113.     MaxLength,
  114.     StrLength,
  115.     CurX      : BYTE;
  116.     WorkStr   : STRING;
  117.     SaveStr   : STRING;
  118.  
  119.     CONSTRUCTOR Init (nx, ny,
  120.                       Fl, MaxL: BYTE;
  121.                       Fc      : CHAR;
  122.                       StartStr: STRING;
  123.                       tx, ty  : BYTE;
  124.                       Title   : STRING;
  125.                       AltHKC  : WORD;
  126.                       NewVSM  : WExtVSMPtr);
  127.     PROCEDURE SetColors (NC : BYTE);
  128.     PROCEDURE Display;                             VIRTUAL;
  129.     PROCEDURE SetActive;                           VIRTUAL;
  130.     PROCEDURE SetPassive;                          VIRTUAL;
  131.     PROCEDURE SetXY (nx, ny : BYTE);               VIRTUAL;
  132.     PROCEDURE CheckMouEv (VAR Ev : EventObj);      VIRTUAL;
  133.     PROCEDURE CheckKeyEv (VAR Ev : EventObj);      VIRTUAL;
  134.     PROCEDURE Edit (VAR Ev : EventObj);            VIRTUAL;
  135.     PROCEDURE SaveConfiguration;                   VIRTUAL;
  136.     PROCEDURE RestoreConfiguration;                VIRTUAL;
  137.  
  138.     FUNCTION CharValid (ch : WORD) : BOOLEAN;      VIRTUAL;
  139.     FUNCTION Result     : STRING;
  140.     FUNCTION FieldValid : BOOLEAN;
  141.     FUNCTION GetFillChar: CHAR;                    VIRTUAL;
  142.     FUNCTION GetBegCol  : BYTE;                    VIRTUAL;
  143.     FUNCTION GetEndCol  : BYTE;                    VIRTUAL;
  144.     FUNCTION GetMaxLen  : BYTE;                    VIRTUAL;
  145.     FUNCTION GetFieldLen: BYTE;                    VIRTUAL;
  146.     FUNCTION GetStrLen  : BYTE;                    VIRTUAL;
  147.     FUNCTION GetCurX    : BYTE;                    VIRTUAL;
  148.     FUNCTION GetFieldX  : BYTE;                    VIRTUAL;
  149.     FUNCTION GetFieldY  : BYTE;                    VIRTUAL;
  150.     FUNCTION GetInsState: BOOLEAN;                 VIRTUAL;
  151.   END;
  152.  
  153.   IntegerFieldPtr = ^IntegerField;
  154.   IntegerField = OBJECT (StringField)
  155.     FUNCTION CharValid (ch : WORD) : BOOLEAN;      VIRTUAL;
  156.     FUNCTION Result     : INTEGER;
  157.     FUNCTION FieldValid : BOOLEAN;
  158.   END;
  159.  
  160.   RealFieldPtr = ^RealField;
  161.   RealField = OBJECT (StringField)
  162.     FUNCTION CharValid (ch : WORD) : BOOLEAN;      VIRTUAL;
  163.     FUNCTION Result     : REAL;
  164.     FUNCTION FieldValid : BOOLEAN;
  165.   END;
  166.  
  167.   StringPtr = ^StringObj;
  168.   StringObj = OBJECT (Base)
  169.     s : ^STRING;
  170.     CONSTRUCTOR Init (ns : STRING);
  171.     FUNCTION GetStr : STRING;
  172.     DESTRUCTOR Done;                               VIRTUAL;
  173.   END;
  174.  
  175.   PickListPtr = ^PickList;
  176.   PickList = OBJECT (SAAItem)
  177.  
  178.     LastEv     : EventObj;
  179.     MaxLen,
  180.     ActiveItem,
  181.     ItemNum,
  182.     BarCol,
  183.     x1, y1,
  184.     x2, y2,
  185.     Col1, Col2,
  186.     Row1, Row2 : BYTE;
  187.     Win        : FrameWindowPtr;
  188.     VScrollBar : ScrollBarPtr;
  189.     ItemList   : DListCollectionPtr;
  190.  
  191.     CONSTRUCTOR Init (nx1, ny1,
  192.                       nx2, ny2 : BYTE;
  193.                       Title    : STRING;
  194.                       AltHKC   : WORD;
  195.                       NewVSM   : WExtVSMPtr);
  196.     PROCEDURE InitData (nx1,ny1,nx2,ny2 : BYTE);   VIRTUAL;
  197.     PROCEDURE Add (Item : StringPtr);              VIRTUAL;
  198.     PROCEDURE Display;                             VIRTUAL;
  199.     PROCEDURE DisplayHotKey;                       VIRTUAL;
  200.     PROCEDURE SetActive;                           VIRTUAL;
  201.     PROCEDURE CheckMouEv (VAR Ev : EventObj);      VIRTUAL;
  202.     PROCEDURE CheckKeyEv (VAR Ev : EventObj);      VIRTUAL;
  203.     PROCEDURE SetXY (nx, ny : BYTE);               VIRTUAL;
  204.  
  205.     { die folgenden Methoden sind intern: }
  206.     PROCEDURE SetBar (ny : INTEGER);               VIRTUAL;
  207.     PROCEDURE ShowActBar;                          VIRTUAL;
  208.     PROCEDURE HideActBar;                          VIRTUAL;
  209.     PROCEDURE Scroll (dx, dy : INTEGER);           VIRTUAL;
  210.     PROCEDURE ShowList;                            VIRTUAL;
  211.     PROCEDURE ClearList;                           VIRTUAL;
  212.     PROCEDURE SetBarCol (BC : BYTE);               VIRTUAL;
  213.  
  214.     FUNCTION GetX1 : BYTE;                         VIRTUAL;
  215.     FUNCTION GetY1 : BYTE;                         VIRTUAL;
  216.     FUNCTION GetX2 : BYTE;                         VIRTUAL;
  217.     FUNCTION GetY2 : BYTE;                         VIRTUAL;
  218.     FUNCTION GetItemNum : BYTE;                    VIRTUAL;
  219.     FUNCTION GetActItem : BYTE;                    VIRTUAL;
  220.     FUNCTION GetBarCol : BYTE;                     VIRTUAL;
  221.     FUNCTION GetRow1 : BYTE;                       VIRTUAL;
  222.     FUNCTION GetRow2 : BYTE;                       VIRTUAL;
  223.     FUNCTION GetCol1 : BYTE;                       VIRTUAL;
  224.     FUNCTION GetCol2 : BYTE;                       VIRTUAL;
  225.     FUNCTION GetWinPtr : FrameWindowPtr;
  226.     FUNCTION GetVScrollBarPtr : ScrollBarPtr;      VIRTUAL;
  227.     FUNCTION GetResult : STRING;                   VIRTUAL;
  228.     FUNCTION GetMaxLen : BYTE;                     VIRTUAL;
  229.     DESTRUCTOR Done;                               VIRTUAL;
  230.   END;
  231.  
  232.   ExtPickListPtr = ^ExtPickList;
  233.   ExtPickList    = OBJECT (PickList)
  234.  
  235.     HScrollBar : ScrollBarPtr;
  236.  
  237.     CONSTRUCTOR Init (nx1, ny1,
  238.                       nx2, ny2 : BYTE;
  239.                       Title    : STRING;
  240.                       AltHKC   : WORD;
  241.                       NewVSM   : WExtVSMPtr);
  242.     PROCEDURE Add (Item : StringPtr);              VIRTUAL;
  243.     PROCEDURE Display;                             VIRTUAL;
  244.     PROCEDURE SetXYRel (dx, dy : INTEGER);         VIRTUAL;
  245.     PROCEDURE CheckMouEv (VAR Ev : EventObj);      VIRTUAL;
  246.     PROCEDURE CheckKeyEv (VAR Ev : EventObj);      VIRTUAL;
  247.     PROCEDURE SetBar (ny : INTEGER);               VIRTUAL;
  248.  
  249.     FUNCTION GetHScrollBarPtr : ScrollBarPtr;      VIRTUAL;
  250.     DESTRUCTOR Done;                               VIRTUAL;
  251.   END;
  252.  
  253.   StandAlonePickListPtr = ^StandAlonePickList;
  254.   StandAlonePickList = OBJECT (ExtPickList)
  255.  
  256.     CONSTRUCTOR Init (nx1, ny1, nx2, ny2 : BYTE;
  257.                       Title : STRING;
  258.                       NewVSM : WExtVSMPtr);
  259.     PROCEDURE CheckEvent (VAR Ev : EventObj);      VIRTUAL;
  260.     FUNCTION GetWinPtr : SAAWindowPtr;             VIRTUAL;
  261.   END;
  262.  
  263.  
  264. IMPLEMENTATION
  265.  
  266. (* ───────────────────────────────────────────────────── *)
  267. (*             Implementation von RadioBut               *)
  268. (* ───────────────────────────────────────────────────── *)
  269. CONSTRUCTOR RadioBut.Init (nx, ny : BYTE;
  270.                            N      : STRING;
  271.                            AltHKC : WORD;
  272.                            NewVSM : WExtVSMPtr);
  273. BEGIN
  274.   IF N[1]<>' ' THEN N := ' '+N;
  275.   IF NOT SAAItem.Init (nx,ny,'( )'+N,AltHKC,NewVSM) THEN
  276.     Fail;
  277. END;
  278.  
  279. PROCEDURE RadioBut.Display;
  280. BEGIN
  281.   SAAItem.Display;
  282.   Mouse^.Hide;
  283.   IF Active THEN BEGIN
  284.     Mouse^.Hide;
  285.     VSM^.WriteChr (Succ (x), y, ItemColor, Chr (7));
  286.     Mouse^.Show;
  287.   END;
  288. END;
  289.  
  290. PROCEDURE RadioBut.SetActive;
  291. BEGIN
  292.   SAAItem.SetActive;
  293.   VSM^.GotoXY (Succ (x), y);
  294. END;
  295.  
  296. PROCEDURE RadioBut.SetPassive;
  297. BEGIN
  298.   SAAItem.SetPassive;
  299.   Display;
  300. END;
  301.  
  302. PROCEDURE RadioBut.CheckEvent (VAR Ev : EventObj);
  303. BEGIN
  304.   SAAItem.CheckEvent (Ev);
  305.   IF ReturnCode=ItSelected THEN
  306.     ReturnCode := ItEvAccepted;
  307.   IF (ReturnCode=ItEvNotMine) AND
  308.      (Active) AND
  309.      (Ev.EventType=EvKeyPressed) THEN
  310.     IF Ev.Key=CurUp THEN BEGIN
  311.       SetPassive;
  312.       ReturnCode := ItActPrev;
  313.     END ELSE
  314.       IF Ev.Key=CurDown THEN BEGIN
  315.         SetPassive;
  316.         ReturnCode := ItActNext;
  317.       END;
  318. END;
  319.  
  320. (* ───────────────────────────────────────────────────── *)
  321. (*             Implementation von PushBut                *)
  322. (* ───────────────────────────────────────────────────── *)
  323. CONSTRUCTOR PushBut.Init (nx, ny : BYTE;
  324.                           N      : STRING;
  325.                           AltHKC : WORD;
  326.                           NOn    : BOOLEAN;
  327.                           NewVSM : WExtVSMPtr);
  328. BEGIN
  329.   IF N[1]<>' ' THEN N := ' '+N;
  330.   IF SAAItem.Init (nx, ny, '[ ]'+N, AltHKC, NewVSM) THEN
  331.     On := NOn
  332.   ELSE
  333.     Fail;
  334. END;
  335.  
  336. PROCEDURE PushBut.Display;
  337. BEGIN
  338.   SAAItem.Display;
  339.   IF On THEN BEGIN
  340.     Mouse^.Hide;
  341.     VSM^.WriteChr (Succ (x), y, ItemColor, 'X');
  342.     Mouse^.Show;
  343.   END;
  344. END;
  345.  
  346. PROCEDURE PushBut.SetActive;
  347. BEGIN
  348.   SAAItem.SetActive;
  349.   VSM^.GotoXY (Succ (x), y);
  350. END;
  351.  
  352. PROCEDURE PushBut.CheckEvent (VAR Ev : EventObj);
  353. BEGIN
  354.   SAAItem.CheckEvent (Ev);
  355.   IF (ReturnCode=ItSelected) OR
  356.      ((ReturnCode=ItEvNotMine) AND
  357.       (Ev.EventType=EvKeyPressed) AND
  358.       (Ev.Key=Space) AND Active) THEN BEGIN
  359.     On := NOT On;
  360.     Display;
  361.     ReturnCode := ItEvAccepted;
  362.   END;
  363. END;
  364.  
  365. PROCEDURE PushBut.SaveConfiguration;
  366. BEGIN
  367.   SaveFl := On;
  368. END;
  369.  
  370. PROCEDURE PushBut.RestoreConfiguration;
  371. BEGIN
  372.   On := SaveFl;
  373. END;
  374.  
  375. FUNCTION PushBut.GetState : BOOLEAN;
  376. BEGIN
  377.   GetState := On;
  378. END;
  379.  
  380. (* ───────────────────────────────────────────────────── *)
  381. (*             Implementation von EndBut                 *)
  382. (* ───────────────────────────────────────────────────── *)
  383. CONSTRUCTOR EndBut.Init (nx, ny : BYTE;
  384.                          N      : STRING;
  385.                          AltHKC : WORD;
  386.                          NewHK  : WORD;
  387.                          NewVSM : WExtVSMPtr);
  388. BEGIN
  389.   IF N[1]<>' ' THEN N := ' '+N;
  390.   IF N[Length (n)]<>' ' THEN N := N+' ';
  391.   IF SAAItem.Init (nx, ny, '<'+N+'>',
  392.                    AltHKC, NewVSM) THEN BEGIN
  393.     HotKeyCode := NewHK; ActCol := EndButActColor;
  394.   END ELSE
  395.     Fail;
  396. END;
  397.  
  398. PROCEDURE EndBut.SetColors (NC, NHKC, NAC : BYTE);
  399. BEGIN
  400.   SAAItem.SetColors (NC, NHKC);
  401.   ActCol := NAC;
  402. END;
  403.  
  404. PROCEDURE EndBut.SetActive;
  405. BEGIN
  406.   SAAItem.SetActive;
  407.   Mouse^.Hide;
  408.   VSM^.FillPartAttr (x, y, Pred (x+Length (Name^)), y,
  409.                      EndButActColor);
  410.   Mouse^.Show;
  411.   VSM^.GotoXY (x+2, y);
  412. END;
  413.  
  414. PROCEDURE EndBut.SetPassive;
  415. BEGIN
  416.   SAAItem.SetPassive;
  417.   Display;
  418. END;
  419.  
  420. PROCEDURE EndBut.CheckEvent (VAR Ev : EventObj);
  421. BEGIN
  422.   SAAItem.CheckEvent (Ev);
  423.   IF (ReturnCode=ItSelected) OR
  424.      ((ReturnCode=ItEvNotMine) AND
  425.       (Ev.EventType=EvKeyPressed) AND
  426.       ((Ev.Key=HotKeyCode) OR
  427.        ((Ev.Key=Enter) AND Active))) THEN BEGIN
  428.     SetActive;
  429.     ReturnCode := ItFinish;
  430.   END;
  431. END;
  432.  
  433. (* ───────────────────────────────────────────────────── *)
  434. (*             Implementation von StringField            *)
  435. (* ───────────────────────────────────────────────────── *)
  436. CONSTRUCTOR StringField.Init (nx, ny,
  437.                               Fl, MaxL: BYTE;
  438.                               Fc      : CHAR;
  439.                               StartStr: STRING;
  440.                               tx, ty  : BYTE;
  441.                               Title   : STRING;
  442.                               AltHKC  : WORD;
  443.                               NewVSM  : WExtVSMPtr);
  444.   VAR i : BYTE;
  445.       InValid : BOOLEAN;
  446. BEGIN
  447.   InValid := FALSE;
  448.   FLength  := Fl;  MaxLength := MaxL;     InsState:= FALSE;
  449.   BegCol   := 1;   EndCol    := FLength;  FillChr := Fc;
  450.   FOR i := 1 TO Length (StartStr) DO
  451.     IF NOT CharValid (Ord (StartStr[i])) THEN
  452.       InValid := TRUE;
  453.   IF InValid THEN
  454.     StartStr := '';
  455.   StrLength:= Length (StartStr);
  456.   CurX     := Succ (StrLength);
  457.   IF CurX>EndCol THEN BEGIN
  458.     EndCol := Succ (CurX);
  459.     BegCol := Succ (EndCol-FLength);
  460.   END;
  461.   FOR i := Length (StartStr) TO Pred (MaxLength) DO
  462.     StartStr := StartStr+FillChr;
  463.   WorkStr := StartStr;
  464.   IF SAAItem.Init (tx, ty, Title,
  465.                    AltHKC, NewVSM) THEN BEGIN
  466.     sx := nx;  sy := ny;
  467.   END ELSE
  468.     Fail;
  469. END;
  470.  
  471. PROCEDURE StringField.SetColors (NC : BYTE);
  472. BEGIN
  473.   Col := NC;
  474. END;
  475.  
  476. PROCEDURE StringField.Display;
  477.   VAR Ch : CHAR;
  478. BEGIN
  479.   SAAItem.Display;
  480.   Mouse^.Hide;
  481.   VSM^.WriteStr (sx, sy, Col,
  482.                  Copy (WorkStr, BegCol, FLength));
  483.   IF (StrLength>FLength) AND
  484.      (EndCol<StrLength) THEN Ch := Chr (16)
  485.                         ELSE Ch := ' ';
  486.   VSM^.WriteChr (sx+FLength, sy, Col, Ch);
  487.   IF (BegCol>1) THEN Ch := Chr (17)
  488.                 ELSE Ch := ' ';
  489.   VSM^.WriteChr (Pred (sx), sy, Col, Ch);
  490.   VSM^.GotoXY (sx+CurX-BegCol, sy);
  491.   Mouse^.Show;
  492. END;
  493.  
  494. PROCEDURE StringField.SetActive;
  495. BEGIN
  496.   SAAItem.SetActive;
  497.   IF InsState THEN BlockCursor;
  498. END;
  499.  
  500. PROCEDURE StringField.SetPassive;
  501. BEGIN
  502.   SAAItem.SetPassive;
  503.   IF InsState THEN NormalCursor;
  504. END;
  505.  
  506. PROCEDURE StringField.SetXY (nx, ny : BYTE);
  507. BEGIN
  508.   sx := sx+nx-x;  sy := sy+ny-y;
  509.   SAAItem.SetXY (nx, ny);
  510. END;
  511.  
  512. PROCEDURE StringField.CheckMouEv (VAR Ev : EventObj);
  513.  
  514.   { im Bereich des Eingabefelds - nicht des Namenfelds ? }
  515.   FUNCTION EvInArea : BOOLEAN;
  516.   BEGIN
  517.     EvInArea := (Ev.X>=sx) AND (Ev.Y=sy) AND
  518.                 (Ev.X<sx+FLength)
  519.   END;
  520.  
  521. BEGIN
  522.   SAAItem.CheckMouEv (Ev);
  523.   IF ReturnCode=ItEvAccepted THEN
  524.     SetActive
  525.   ELSE BEGIN
  526.     ReturnCode := ItEvNotMine;
  527.     IF EvInArea THEN
  528.       IF (EvHand^.MouReleased (Ev)) OR
  529.          (EvHand^.MouPressed (Ev)) OR
  530.          (Ev.Buttons>0) THEN BEGIN
  531.         SetActive;
  532.         REPEAT
  533.           CurX := (Ev.X-sx) + BegCol;
  534.           IF CurX>StrLength THEN
  535.             CurX := Succ (StrLength);
  536.           VSM^.GotoXY (sx+CurX-BegCol, sy);
  537.           EvHand^.WaitForEvent (EvAll, Ev);
  538.         UNTIL ((Ev.EventType=EvMouMove) AND
  539.                NOT EvInArea) OR
  540.               ((Ev.EventType AND EvKeyAll)>0) OR
  541.               (EvHand^.MouReleased (Ev));
  542.         IF EvInArea AND EvHand^.MouReleased (Ev) THEN
  543.           ReturnCode := ItEvAccepted
  544.         ELSE IF (Ev.EventType AND EvKeyAll)>0 THEN
  545.           CheckKeyEv (Ev)
  546.         ELSE BEGIN
  547.           SetPassive;
  548.           ReturnCode := ItEvNotMine;
  549.         END;
  550.       END;
  551.   END;
  552. END;
  553.  
  554. PROCEDURE StringField.CheckKeyEv (VAR Ev : EventObj);
  555. BEGIN
  556.   ReturnCode := ItEvNotMine;
  557.   IF NOT Active THEN BEGIN
  558.     SAAItem.CheckKeyEv (Ev);
  559.     IF ReturnCode=ItSelected THEN
  560.       ReturnCode := ItEvAccepted;
  561.   END;
  562.   IF (Active) AND
  563.      (ReturnCode=ItEvNotMine) AND
  564.      (Ev.EventType=EvKeyPressed) THEN
  565.     Edit (Ev);
  566. END;
  567.  
  568. PROCEDURE StringField.Edit (VAR Ev : EventObj);
  569.   VAR
  570.     Quit     : BOOLEAN;
  571. BEGIN
  572.   Quit := FALSE;
  573.   IF InsState THEN BlockCursor;
  574.   REPEAT
  575.     IF (Ev.EventType=EvKeyPressed) THEN BEGIN
  576.       {------------- Normale Taste gedrückt ? ------------}
  577.       IF (Ev.Key>=32) AND (Ev.Key<=255) AND
  578.          (CurX<=MaxLength) AND
  579.          (CharValid (Ev.Key)) THEN BEGIN
  580.         IF InsState THEN BEGIN                { einfügen }
  581.           IF Succ (StrLength)<=MaxLength THEN BEGIN
  582.             WorkStr[0] := Chr (Pred (MaxLength));
  583.             System.Insert (Chr (Ev.Key), WorkStr, CurX);
  584.             Inc (StrLength);
  585.           END ELSE
  586.             Dec (CurX);
  587.         END ELSE BEGIN               { oder überschreiben }
  588.           WorkStr[CurX] := Chr (Ev.Key);
  589.           IF CurX>StrLength THEN
  590.             Inc (StrLength);
  591.         END;
  592.         Inc (CurX);
  593.         IF (CurX>EndCol) THEN BEGIN
  594.           Inc (EndCol);  Inc (BegCol);
  595.         END;
  596.         IF (CurX>MaxLength) THEN BEGIN
  597.           Dec (CurX);  Dec (EndCol);  Dec (BegCol);
  598.         END;
  599.       {----------- "Spezielle" Taste gedrückt ? ----------}
  600.       END ELSE BEGIN
  601.         CASE Ev.Key OF
  602.           CtrlS   : Ev.Key := CurLeft;
  603.           CtrlD   : Ev.Key := CurRight;
  604.         END;
  605.         CASE Ev.Key OF
  606.           Enter   : BEGIN
  607.                       SetPassive;
  608.                       ReturnCode := ItFinish;
  609.                       Quit       := TRUE;
  610.                     END;
  611.           CurLeft : IF CurX>1 THEN BEGIN
  612.                       Dec (CurX);
  613.                       IF CurX<BegCol THEN BEGIN
  614.                         Dec (BegCol);  Dec (EndCol);
  615.                       END;
  616.                     END;
  617.           CurRight: IF (CurX<=StrLength) THEN BEGIN
  618.                       Inc (CurX);
  619.                       IF CurX>EndCol THEN BEGIN
  620.                         Inc (BegCol);  Inc (EndCol)
  621.                       END;
  622.                     END;
  623.           BackSpace:IF (StrLength>0) AND
  624.                        (CurX>1) THEN BEGIN
  625.                       Dec (CurX);  Dec (StrLength);
  626.                       Delete (WorkStr, CurX, 1);
  627.                       WorkStr := WorkStr+FillChr;
  628.                       IF CurX<BegCol THEN BEGIN
  629.                         Dec (BegCol);  Dec (EndCol);
  630.                       END;
  631.                     END;
  632.           Del     : IF (StrLength>0) AND
  633.                        (CurX<=StrLength) THEN BEGIN
  634.                       Delete (WorkStr, CurX, 1);
  635.                       WorkStr := WorkStr+FillChr;
  636.                       Dec (StrLength)
  637.                     END;
  638.           Ins     : BEGIN
  639.                       InsState := NOT InsState;
  640.                       IF InsState THEN
  641.                         BlockCursor
  642.                       ELSE
  643.                         NormalCursor;
  644.                     END;
  645.           CtrlY   : BEGIN
  646.                       FillChar (WorkStr,
  647.                                 Succ (MaxLength),
  648.                                 FillChr);
  649.                       WorkStr[0] := Chr (MaxLength);
  650.                       CurX       := 1;  BegCol := 1;
  651.                       EndCol     := FLength;
  652.                       StrLength  := 0;
  653.                     END;
  654.           CurHome : BEGIN
  655.                       CurX := 1;  BegCol := 1;
  656.                       EndCol := FLength;
  657.                     END;
  658.           CurEnd  : BEGIN
  659.                       IF StrLength>FLength THEN BEGIN
  660.                         EndCol := Succ (StrLength);
  661.                         BegCol := Succ (EndCol-FLength);
  662.                         CurX   := StrLength;
  663.                       END ELSE
  664.                         CurX := Succ (StrLength);
  665.                       IF (StrLength=MaxLength) THEN
  666.                         Dec (CurX);
  667.                     END;
  668.         ELSE             { Tastendruck nicht ausgewertet }
  669.           Quit := TRUE;
  670.         END;
  671.       END;
  672.       Display;
  673.     END ELSE
  674.       IF (Ev.EventType AND EvMouAll>0) THEN
  675.         Quit := TRUE;
  676.     IF NOT Quit THEN
  677.       Evhand^.WaitForEvent (EvAll, Ev)
  678.     ELSE
  679.       IF (Ev.EventType AND EvMouAll)>0 THEN
  680.         CheckMouEv (Ev);
  681.       { vielleicht betrifft das Mausevent StringField,
  682.         dann braucht nicht zum Aufrufer zurückgesprungen
  683.         zu werden. }
  684.  
  685.   UNTIL Quit;
  686. END;
  687.  
  688. PROCEDURE StringField.SaveConfiguration;
  689. BEGIN
  690.   SaveStr := WorkStr;
  691. END;
  692.  
  693. PROCEDURE StringField.RestoreConfiguration;
  694. BEGIN
  695.   WorkStr := SaveStr;
  696. END;
  697.  
  698. FUNCTION StringField.CharValid (ch : WORD) : BOOLEAN;
  699. BEGIN
  700.   CharValid := (ch>=32) AND (ch<=255);
  701. END;
  702.  
  703. FUNCTION StringField.Result : STRING;
  704. BEGIN
  705.   Result := Copy (WorkStr, 1, StrLength);
  706. END;
  707.  
  708. FUNCTION StringField.FieldValid : BOOLEAN;
  709. BEGIN
  710.   FieldValid := TRUE;
  711. END;
  712.  
  713. FUNCTION StringField.GetFillChar : CHAR;
  714. BEGIN
  715.   GetFillChar := FillChr;
  716. END;
  717.  
  718. FUNCTION StringField.GetBegCol : BYTE;
  719. BEGIN
  720.   GetBegCol := BegCol;
  721. END;
  722.  
  723. FUNCTION StringField.GetEndCol : BYTE;
  724. BEGIN
  725.   GetEndCol := EndCol;
  726. END;
  727.  
  728. FUNCTION StringField.GetMaxLen : BYTE;
  729. BEGIN
  730.   GetMaxLen := MaxLength;
  731. END;
  732.  
  733. FUNCTION StringField.GetFieldLen : BYTE;
  734. BEGIN
  735.   GetFieldLen := FLength;
  736. END;
  737.  
  738. FUNCTION StringField.GetStrLen : BYTE;
  739. BEGIN
  740.   GetStrLen := StrLength;
  741. END;
  742.  
  743. FUNCTION StringField.GetCurX : BYTE;
  744. BEGIN
  745.   GetCurX := CurX;
  746. END;
  747.  
  748. FUNCTION StringField.GetFieldX : BYTE;
  749. BEGIN
  750.   GetFieldX := sx;
  751. END;
  752.  
  753. FUNCTION StringField.GetFieldY : BYTE;
  754. BEGIN
  755.   GetFieldY := sy;
  756. END;
  757.  
  758. FUNCTION StringField.GetInsState : BOOLEAN;
  759. BEGIN
  760.   GetInsState := InsState;
  761. END;
  762.  
  763. (* ───────────────────────────────────────────────────── *)
  764. (*           Implementation von IntegerField             *)
  765. (* ───────────────────────────────────────────────────── *)
  766. FUNCTION IntegerField.CharValid (ch : WORD) : BOOLEAN;
  767. BEGIN
  768.   CharValid := ((ch>=48) AND (ch<=57)) OR
  769.                (ch=43) OR (ch=45);
  770. END;
  771.  
  772. FUNCTION IntegerField.Result : INTEGER;
  773.   VAR Res, Err : INTEGER;
  774.       s : STRING;
  775. BEGIN
  776.   s := StringField.Result;
  777.   IF (s[1]=#43) OR (s[1]=#45) THEN
  778.     Delete (s, 1, 1);
  779.   IF (s>'32767') THEN Err := 1
  780.                  ELSE Val (StringField.Result, Res, Err);
  781.   IF Err>0 THEN
  782.     ReturnCode := ResultInvalid
  783.   ELSE
  784.     Result := Res;
  785. END;
  786.  
  787. FUNCTION IntegerField.FieldValid : BOOLEAN;
  788.   VAR Res : INTEGER;
  789. BEGIN
  790.   Res := Result;
  791.   FieldValid := (ReturnCode<>ResultInvalid);
  792. END;
  793.  
  794. (* ───────────────────────────────────────────────────── *)
  795. (*           Implementation von RealField                *)
  796. (* ───────────────────────────────────────────────────── *)
  797. FUNCTION RealField.CharValid (ch : WORD) : BOOLEAN;
  798. BEGIN
  799.   CharValid := ((ch>=48) AND (ch<=57)) OR
  800.                (ch=43) OR (ch=45) OR
  801.                (ch=46);
  802. END;
  803.  
  804. FUNCTION RealField.Result : REAL;
  805.   VAR Res : REAL; Err : INTEGER;
  806. BEGIN
  807.   Val (StringField.Result, Res, Err);
  808.   IF Err>0 THEN
  809.     ReturnCode := ResultInvalid
  810.   ELSE
  811.     Result := Res;
  812. END;
  813.  
  814. FUNCTION RealField.FieldValid : BOOLEAN;
  815.   VAR Res : REAL;
  816. BEGIN
  817.   Res := Result;
  818.   FieldValid := (ReturnCode<>ResultInvalid);
  819. END;
  820.  
  821. (* ───────────────────────────────────────────────────── *)
  822. (*            Implementation von StringObj               *)
  823. (* ───────────────────────────────────────────────────── *)
  824. CONSTRUCTOR StringObj.Init (ns : STRING);
  825. BEGIN
  826.   GetMem (s, Succ (Length (ns)));
  827.   IF s<>NIL THEN s^ := ns
  828.             ELSE Fail
  829. END;
  830.  
  831. FUNCTION StringObj.GetStr : STRING;
  832. BEGIN
  833.   GetStr := s^;
  834. END;
  835.  
  836. DESTRUCTOR StringObj.Done;
  837. BEGIN
  838.   FreeMem (s, Succ (Length (s^)));
  839. END;
  840.  
  841. (* ───────────────────────────────────────────────────── *)
  842. (*            Implementation von PickList                *)
  843. (* ───────────────────────────────────────────────────── *)
  844. CONSTRUCTOR PickList.Init (nx1, ny1,
  845.                            nx2, ny2 : BYTE;
  846.                            Title    : STRING;
  847.                            AltHKC   : WORD;
  848.                            NewVSM   : WExtVSMPtr);
  849. BEGIN
  850.   IF SAAItem.Init ((nx2+nx1-Length (Title)) DIV 2, ny1,
  851.                    Title, AltHKC, NewVSM) THEN BEGIN
  852.     Win := New (FrameWindowPtr, Init (VSM));
  853.     VScrollBar := New (VertScrollBarPtr, Init (VSM));
  854.     ItemList := New (DListCollectionPtr, Init);
  855.     IF (Win=NIL) OR
  856.        (VScrollBar=NIL) OR
  857.        (ItemList=NIL) THEN
  858.       Fail
  859.     ELSE
  860.       InitData (nx1, ny1, nx2, ny2);
  861.   END ELSE
  862.     Fail;
  863. END;
  864.  
  865. PROCEDURE PickList.InitData (nx1, ny1, nx2, ny2 : BYTE);
  866. BEGIN
  867.   x1 := nx1;  y1 := ny1;  x2 := nx2;  y2 := ny2;
  868.   Row1 := 1;  Row2 := Pred (y2-y1);
  869.   Col1 := 1;  Col2 := Pred (x2-x1);
  870.   BarCol := ActiveBarColor;
  871.   ActiveItem := 0;
  872.   ItemNum := 0;
  873.   Win^.SetXY (x1, y1, x2, y2);
  874.   Win^.SetColors (Col, Col, 0, 0);
  875.   VScrollBar^.SetXY (x2, Succ (y1), x2, Pred (y2));
  876. END;
  877.  
  878. PROCEDURE PickList.Add (Item : StringPtr);
  879. BEGIN
  880.   IF Item<>NIL THEN BEGIN
  881.     IF Length (Item^.GetStr)>MaxLen THEN
  882.       MaxLen := Length (Item^.GetStr);
  883.     ItemList^.Put (Item);
  884.     Inc (ItemNum);
  885.   END;
  886. END;
  887.  
  888. PROCEDURE PickList.Display;
  889. BEGIN
  890.   IF ItemNum=0 THEN
  891.     Add (New (StringPtr, Init ('')));
  892.   Mouse^.Hide;
  893.   Win^.Show;
  894.   IF Win^.IsOpened THEN BEGIN
  895.     SAAItem.Display;
  896.     IF ActiveItem=0 THEN
  897.       VScrollBar^.SetMaxPos (ItemNum, 1)
  898.     ELSE
  899.       VScrollBar^.SetMaxPos (ItemNum, ActiveItem);
  900.     VScrollBar^.Show;
  901.     ShowList;
  902.     SetBar (ActiveItem);
  903.   END;
  904.   Mouse^.Show;
  905. END;
  906.  
  907. PROCEDURE PickList.DisplayHotKey;
  908. BEGIN
  909.   SAAItem.DisplayHotKey;
  910. END;
  911.  
  912. PROCEDURE PickList.SetActive;
  913. BEGIN
  914.   IF Displayed THEN BEGIN
  915.     SAAItem.SetActive;
  916.     IF ActiveItem=0 THEN
  917.       Inc (ActiveItem);
  918.     ShowActBar;
  919.   END;
  920. END;
  921.  
  922. PROCEDURE PickList.CheckKeyEv (VAR Ev : EventObj);
  923. BEGIN
  924.   ReturnCode := ItEvNotMine;
  925.   SAAItem.CheckKeyEv (Ev);
  926.   IF ReturnCode=ItSelected THEN BEGIN
  927.     ReturnCode := ItEvAccepted;
  928.     SetBar (ActiveItem);
  929.   END ELSE
  930.     IF (ReturnCode=ItEvNotMine) AND
  931.        (Ev.EventType=EvKeyPressed) AND (Active) THEN
  932.       CASE Ev.Key OF
  933.         Enter  : ReturnCode := ItSelected;
  934.         CurDown: BEGIN
  935.                    ReturnCode := ItEvAccepted;
  936.                    SetBar (Succ (ActiveItem));
  937.                  END;
  938.         CurUp  : BEGIN
  939.                    ReturnCode := ItEvAccepted;
  940.                    SetBar (Pred (ActiveItem));
  941.                  END;
  942.          CtrlHome:BEGIN
  943.                    ReturnCode := ItEvAccepted;
  944.                    SetBar (1);
  945.                  END;
  946.         CtrlEnd :BEGIN
  947.                    ReturnCode := ItEvAccepted;
  948.                    SetBar (ItemNum);
  949.                  END;
  950.        END;
  951. END;
  952.  
  953. PROCEDURE PickList.CheckMouEv (VAR Ev : EventObj);
  954.   VAR ScrY : INTEGER;  Answer : BYTE;
  955. BEGIN
  956.   ReturnCode := ItEvNotMine;  ScrY := 0;  Answer := 0;
  957.   {--------------- innerhalb des Fensters ? --------------}
  958.   IF (Ev.X>x1) AND (Ev.X<x2) THEN BEGIN
  959.     IF (Ev.Y>y1) AND (Ev.Y<y2) AND
  960.        (EvHand^.MouPressed (Ev) OR
  961.         EvHand^.MouReleased (Ev) OR
  962.         (Ev.Buttons>0)) THEN BEGIN
  963.       ReturnCode := ItEvAccepted;
  964.       IF NOT Active THEN
  965.         SetActive;
  966.       SetBar (Pred (Ev.Y-y1)+Row1);
  967.       IF (Evhand^.MouPressed (Ev)) AND
  968.          (EvHand^.MouReleased (LastEv)) AND
  969.          (Ev.X=LastEv.X) AND
  970.          (Ev.Y=LastEv.Y) AND
  971.          (Ev.Time<LastEv.Time+DoubleClickTime) THEN
  972.         ReturnCode := ItSelected;
  973.     END ELSE
  974.       IF (Ev.X>x1) AND (Ev.X<x2) AND
  975.          (EvHand^.MouPressed (Ev)) THEN BEGIN
  976.         IF Ev.Y=y1 THEN ScrY := -1;
  977.         IF Ev.Y=y2 THEN ScrY := 1;
  978.       END;
  979.   END;
  980.   {--------------- Im ScrollBalken ? ---------------------}
  981.   IF ((ReturnCode=ItEvNotMine) AND
  982.       (EvHand^.MouPressed (Ev))) OR
  983.      (ScrY<>0) THEN BEGIN
  984.     VScrollBar^.CheckMouEv (Ev);
  985.     Answer := VScrollBar^.GetReturnCode;
  986.     CASE Answer OF
  987.       SBScrollUp  : ScrY := -1;
  988.       SBScrollDown: ScrY :=  1;
  989.       SBScrollPgUp: ScrY := -Pred (y2-y1);
  990.       SBScrollPgDn: ScrY := Pred (y2-y1);
  991.     END;
  992.     IF ScrY<>0 THEN BEGIN
  993.       IF NOT Active THEN
  994.         SetActive;
  995.       REPEAT
  996.         EvHand^.PeekEvent (Ev);
  997.         IF Ev.Time=MaxLongInt THEN BEGIN
  998.           IF Abs (ScrY)>1 THEN
  999.             VSM^.Delay (MouseDelay*3)
  1000.           ELSE
  1001.             VSM^.Delay (MouseDelay);
  1002.           SetBar (ActiveItem+ScrY);
  1003.         END;
  1004.       UNTIL (EvHand^.MouReleased (Ev)) OR
  1005.             (Ev.EventType=EvMouMove);
  1006.       ReturnCode := ItEvAccepted;
  1007.     END;
  1008.     IF (Answer=SBGotoPos) THEN BEGIN
  1009.       IF NOT Active THEN
  1010.         SetActive;
  1011.       SetBar (VScrollBar^.GetPos);
  1012.       ReturnCode := ItEvAccepted;
  1013.     END;
  1014.   END;
  1015.   LastEv := Ev;
  1016. END;
  1017.  
  1018. PROCEDURE PickList.SetXY (nx, ny : BYTE);
  1019. BEGIN
  1020.   x1 := x1+(nx-x);  x2 := x2+(nx-x);
  1021.   y1 := y1+(ny-y);  y2 := y2+(ny-y);
  1022.   IF Displayed THEN
  1023.     Win^.Hide;
  1024.   Win^.SetXY (x1, y1, x2, y2);
  1025.   VScrollBar^.SetXYRel (nx-x, ny-y);
  1026.   SAAItem.SetXY (nx, ny);
  1027.     { das Öffnen wird von Display übernommen, das
  1028.       von SAAItem.SetXY automatisch aufgerufen wird. }
  1029. END;
  1030.  
  1031. PROCEDURE PickList.SetBar (ny : INTEGER);
  1032. BEGIN
  1033.   IF (ny=ActiveItem) AND (ActiveItem=0) THEN
  1034.     Exit;
  1035.   IF ny<1 THEN
  1036.     ny := 1;
  1037.   IF ny>ItemNum THEN
  1038.     ny := ItemNum;
  1039.   IF ActiveItem<>ny THEN BEGIN
  1040.     HideActBar;
  1041.     IF ny>Row2 THEN
  1042.       Scroll (0, ny-Row2);
  1043.     IF ny<Row1 THEN
  1044.       Scroll (0, INTEGER (ny-Row1));
  1045.     ActiveItem := ny;
  1046.     ShowActBar;
  1047.     VScrollBar^.ChangePos (ItemNum, ActiveItem);
  1048.   END;
  1049. END;
  1050.  
  1051. PROCEDURE PickList.ShowActBar;
  1052. BEGIN
  1053.   Mouse^.Hide;
  1054.   VSM^.FillPartAttr (Succ(X1), Succ (Y1+ActiveItem-Row1),
  1055.                      Pred(X2), Succ (y1+ActiveItem-Row1),
  1056.                      BarCol);
  1057.   VSM^.GotoXY (Succ (x1),
  1058.                Succ (y1+ActiveItem-Row1));
  1059.   Mouse^.Show;
  1060. END;
  1061.  
  1062. PROCEDURE PickList.HideActBar;
  1063. BEGIN
  1064.   Mouse^.Hide;
  1065.   VSM^.FillPartAttr (Succ(X1), Succ (Y1+ActiveItem-Row1),
  1066.                      Pred(X2), Succ (y1+ActiveItem-Row1),
  1067.                      Col);
  1068.   Mouse^.Show;
  1069. END;
  1070.  
  1071. PROCEDURE PickList.Scroll (dx, dy : INTEGER);
  1072. BEGIN
  1073.   IF dx+Col2>MaxLen THEN
  1074.     dx := MaxLen-Col2;
  1075.   IF dx+Col1<1 THEN
  1076.     dx := -Pred (Col1);
  1077.   IF dy+ActiveItem>ItemNum THEN
  1078.     dy := ItemNum-ActiveItem;
  1079.   IF dy+ActiveItem<1 THEN
  1080.     dy := -Pred (ActiveItem);
  1081.   IF (dy<>0) OR (dx<>0) THEN BEGIN
  1082.     Inc (Row1, dy);  Inc (Row2, dy);
  1083.     Inc (Col1, dx);  Inc (Col2, dx);
  1084.     ShowList;   { der Einfachkeit halber }
  1085.   END;
  1086. END;
  1087.  
  1088. PROCEDURE PickList.ShowList;
  1089.   VAR i : WORD;    { geht den sichtbaren Listenausschnitt }
  1090.       Str : STRING;            { durch und zeigt Items an }
  1091. BEGIN
  1092.   Mouse^.Hide;
  1093.   VSM^.FillPart (Succ (x1), Succ (y1),
  1094.                  Pred (x2), Pred (y2), Col, ' ');
  1095.   ItemList^.SetActNodeTo (Row1);
  1096.   Str := StringPtr (ItemList^.GetActData)^.GetStr;
  1097.   FOR i := Row1 TO Row2 DO BEGIN
  1098.     IF i<=ItemNum THEN BEGIN
  1099.       VSM^.WriteStr (Succ (x1), Succ (y1+i-Row1),
  1100.                      Col,
  1101.                      Copy (Str, Col1, Succ (Col2-Col1)));
  1102.       Str := StringPtr (ItemList^.GotoNextData)^.GetStr;
  1103.     END;
  1104.   END;
  1105.   Mouse^.Show;
  1106. END;
  1107.  
  1108. PROCEDURE PickList.ClearList;
  1109. BEGIN
  1110.   ItemList^.Clear;
  1111.   ItemNum := 0;  ActiveItem := 0;
  1112.   Row1 := 1;  Row2 := Pred (y2-y1);
  1113.   Col1 := 1;  Col2 := Pred (x2-x1);
  1114. END;
  1115.  
  1116. PROCEDURE PickList.SetBarCol (BC : BYTE);
  1117. BEGIN
  1118.   BarCol := BC;
  1119. END;
  1120.  
  1121. FUNCTION PickList.GetX1 : BYTE;
  1122. BEGIN
  1123.   GetX1 := x1;
  1124. END;
  1125.  
  1126. FUNCTION PickList.GetY1 : BYTE;
  1127. BEGIN
  1128.   GetY1 := y1;
  1129. END;
  1130.  
  1131. FUNCTION PickList.GetX2 : BYTE;
  1132. BEGIN
  1133.   GetX2 := x2;
  1134. END;
  1135.  
  1136. FUNCTION PickList.GetY2 : BYTE;
  1137. BEGIN
  1138.   GetY2 := y2;
  1139. END;
  1140.  
  1141. FUNCTION PickList.GetItemNum : BYTE;
  1142. BEGIN
  1143.   GetItemNum := ItemNum;
  1144. END;
  1145.  
  1146. FUNCTION PickList.GetActItem : BYTE;
  1147. BEGIN
  1148.   GetActItem := ActiveItem;
  1149. END;
  1150.  
  1151. FUNCTION PickList.GetBarCol : BYTE;
  1152. BEGIN
  1153.   GetBarCol := BarCol;
  1154. END;
  1155.  
  1156. FUNCTION PickList.GetRow1 : BYTE;
  1157. BEGIN
  1158.   GetRow1 := Row1;
  1159. END;
  1160.  
  1161. FUNCTION PickList.GetRow2 : BYTE;
  1162. BEGIN
  1163.   GetRow2 := Row2;
  1164. END;
  1165.  
  1166. FUNCTION PickList.GetCol1 : BYTE;
  1167. BEGIN
  1168.   GetCol1 := Col1;
  1169. END;
  1170.  
  1171. FUNCTION PickList.GetCol2 : BYTE;
  1172. BEGIN
  1173.   GetCol2 := Col2;
  1174. END;
  1175.  
  1176. FUNCTION PickList.GetWinPtr : FrameWindowPtr;
  1177. BEGIN
  1178.   GetWinPtr := Win;
  1179. END;
  1180.  
  1181. FUNCTION PickList.GetVScrollBarPtr : ScrollBarPtr;
  1182. BEGIN
  1183.   GetVScrollBarPtr := VscrollBar;
  1184. END;
  1185.  
  1186. FUNCTION PickList.GetResult : STRING;
  1187. BEGIN
  1188.   WITH ItemList^ DO BEGIN
  1189.     SetActNodeTo (ActiveItem);
  1190.     GetResult := StringPtr (GetActData)^.GetStr;
  1191.   END;
  1192. END;
  1193.  
  1194. FUNCTION PickList.GetMaxLen : BYTE;
  1195. BEGIN
  1196.   GetMaxLen := MaxLen;
  1197. END;
  1198.  
  1199. DESTRUCTOR PickList.Done;
  1200. BEGIN
  1201.   SAAItem.Done;
  1202.   Dispose (Win, Done);
  1203.   Dispose (VScrollBar, Done);
  1204.   Dispose (ItemList, Done);
  1205. END;
  1206.  
  1207. (* ───────────────────────────────────────────────────── *)
  1208. (*          Implementation von ExtPickList               *)
  1209. (* ───────────────────────────────────────────────────── *)
  1210. CONSTRUCTOR ExtPickList.Init (nx1, ny1,
  1211.                               nx2, ny2 : BYTE;
  1212.                               Title    : STRING;
  1213.                               AltHKC   : WORD;
  1214.                               NewVSM   : WExtVSMPtr);
  1215. BEGIN
  1216.   IF PickList.Init (nx1, ny1, nx2, ny2,
  1217.                     Title, AltHKC, NewVSM) THEN BEGIN
  1218.     HScrollBar := New (HorizScrollBarPtr, Init (VSM));
  1219.     IF HScrollBar=NIL THEN
  1220.       Fail
  1221.     ELSE
  1222.       HScrollBar^.SetXY (Succ (x1), y2,
  1223.                          Pred (x2), y2);
  1224.   END ELSE
  1225.     Fail;
  1226. END;
  1227.  
  1228. PROCEDURE ExtPickList.Add (Item : StringPtr);
  1229. BEGIN
  1230.   PickList.Add (Item);
  1231.   HScrollBar^.SetMaxPos (MaxLen, Col1);
  1232. END;
  1233.  
  1234. PROCEDURE ExtPickList.Display;
  1235. BEGIN
  1236.   IF (ItemNum>0) AND NOT Displayed THEN BEGIN
  1237.     PickList.Display;
  1238.     HScrollBar^.SetMaxPos (MaxLen, Col1);
  1239.     HScrollBar^.Show;
  1240.   END;
  1241. END;
  1242.  
  1243. PROCEDURE ExtPickList.SetXYRel (dx, dy : INTEGER);
  1244. BEGIN
  1245.   HScrollBar^.SetXYRel (dx, dy);
  1246.   PickList.SetXYRel (dx, dy);
  1247. END;
  1248.  
  1249. PROCEDURE ExtPickList.CheckMouEv (VAR Ev : EventObj);
  1250.   VAR ScrX : INTEGER;  Answer : BYTE;
  1251. BEGIN
  1252.   ReturnCode := ItEvNotMine;  ScrX := 0;
  1253.   IF NOT ((Ev.X>x1) AND
  1254.           (Ev.X<x2) AND (Ev.Y=y2)) THEN
  1255.     PickList.CheckMouEv (Ev);
  1256.     { darf nur auf unterem Fensterrand sein, da sich dorg
  1257.       jetzt der horizontale Scrollbalken befindet. }
  1258.  
  1259.   IF (ReturnCode=ItEvNotMine) AND
  1260.      (Ev.Y>y1) AND (Ev.Y<y2) AND (Ev.X=x1) AND
  1261.      (EvHand^.MouPressed (Ev)) THEN
  1262.     ScrX := -1;
  1263.   IF (ReturnCode=ItEvNotMine) AND
  1264.      ((EvHand^.MouPressed (Ev)) OR (ScrX<>0)) THEN BEGIN
  1265.     HScrollBar^.CheckMouEv (Ev);
  1266.     Answer := HScrollBar^.GetReturnCode;
  1267.     CASE Answer OF
  1268.       SBScrollUp  : ScrX := -1;
  1269.       SBScrollDown: ScrX :=  1;
  1270.       SBScrollPgUp: ScrX := -Pred (x2-x1);
  1271.       SBScrollPgDn: ScrX := Pred (x2-x1);
  1272.     END;
  1273.     IF (ScrX<>0) THEN BEGIN
  1274.       IF NOT Active THEN
  1275.         SetActive;
  1276.       REPEAT
  1277.         EvHand^.PeekEvent (Ev);
  1278.         IF Ev.Time=MaxLongInt THEN BEGIN
  1279.           IF Abs (ScrX)>1 THEN
  1280.             VSM^.Delay (MouseDelay*3)
  1281.           ELSE
  1282.             VSM^.Delay (MouseDelay);
  1283.           Scroll (ScrX, 0);
  1284.           SetBar (ActiveItem);
  1285.         END
  1286.       UNTIL (EvHand^.MouReleased (Ev)) OR
  1287.             (Ev.EventType=EvMouMove);
  1288.       ReturnCode := ItEvAccepted;
  1289.     END;
  1290.     IF (Answer=SBGotoPos) THEN BEGIN
  1291.       IF NOT Active THEN
  1292.         SetActive;
  1293.       Scroll (INTEGER (HScrollBar^.GetPos-Col1), 0);
  1294.       SetBar (ActiveItem);
  1295.       ReturnCode := ItEvAccepted;
  1296.     END;
  1297.     LastEv := Ev;
  1298.   END;
  1299. END;
  1300.  
  1301. PROCEDURE ExtPickList.CheckKeyEv (VAR Ev : EventObj);
  1302. BEGIN
  1303.   PickList.CheckKeyEv (Ev);
  1304.   IF (ReturnCode=ItEvNotMine) AND
  1305.      (Ev.EventType=EvKeyPressed) AND (Active) THEN BEGIN
  1306.     CASE Ev.Key OF
  1307.       CurRight: BEGIN
  1308.                   ReturnCode := ItEvAccepted;
  1309.                   Scroll (1, 0);
  1310.                 END;
  1311.       CurLeft : BEGIN
  1312.                   ReturnCode := ItEvAccepted;
  1313.                   Scroll (-1, 0);
  1314.                 END;
  1315.       CurHome : BEGIN
  1316.                   ReturnCode := ItEvAccepted;
  1317.                   Scroll (-Pred (Row1), 0);
  1318.                 END;
  1319.       CurEnd  : BEGIN
  1320.                   ReturnCode := ItEvAccepted;
  1321.                   Scroll (MaxLen-Row2, 0);
  1322.                 END;
  1323.     END;
  1324.     IF ReturnCode=ItEvAccepted THEN
  1325.       SetBar (ActiveItem);
  1326.   END;
  1327. END;
  1328.  
  1329. PROCEDURE ExtPickList.SetBar (ny : INTEGER);
  1330. BEGIN
  1331.   PickList.SetBar (ny);
  1332.   HScrollBar^.ChangePos (MaxLen, Col1);
  1333. END;
  1334.  
  1335. FUNCTION ExtPickList.GetHScrollBarPtr : ScrollBarPtr;
  1336. BEGIN
  1337.   GetHScrollBarPtr := HScrollBar;
  1338. END;
  1339.  
  1340. DESTRUCTOR ExtPickList.Done;
  1341. BEGIN
  1342.   PickList.Done;
  1343.   Dispose (HScrollBar, Done);
  1344. END;
  1345.  
  1346. (* ───────────────────────────────────────────────────── *)
  1347. (*          Implementation von StandAlonePickList        *)
  1348. (* ───────────────────────────────────────────────────── *)
  1349. CONSTRUCTOR StandAlonePickList.Init (nx1,ny1,nx2,ny2:BYTE;
  1350.                                      Title : STRING;
  1351.                                      NewVSM : WExtVSMPtr);
  1352. BEGIN
  1353.   IF ExtPickList.Init (nx1, ny1, nx2, ny2,
  1354.                        '', 0,
  1355.                        NewVSM) THEN BEGIN
  1356.     Dispose (Win, Done);
  1357.     Win := New (SAAWindowPtr, Init (VSM));
  1358.     IF Win<>NIL THEN BEGIN
  1359.       Win^.SetXY (x1, y1, x2, y2);
  1360.       Win^.SetColors (Col, Col, 0, 0);
  1361.       Win^.SetTitles (Title, '');
  1362.       MaxLen := 0;
  1363.     END ELSE
  1364.       Fail;
  1365.   END ELSE
  1366.     Fail;
  1367. END;
  1368.  
  1369. PROCEDURE StandAlonePickList.CheckEvent (VAR Ev : EventObj);
  1370.   VAR OldX, OldY, Answer : BYTE;
  1371. BEGIN
  1372.   IF NOT Win^.IsOpened THEN
  1373.     Exit;
  1374.  
  1375.   ReturnCode := ItEvNotMine;
  1376.   IF NOT (((Ev.EventType AND EvMouAll)>0) AND
  1377.           (Ev.X>x1) AND (Ev.X<x2) AND (Ev.Y=y1) AND
  1378.           (Ev.Buttons>0)) THEN
  1379.     PickList.CheckEvent (Ev);
  1380.     { darf nicht auf oberem Fensterrand sein, denn das
  1381.       soll beim Fenster Bewegung auslösen. }
  1382.  
  1383.   IF (ReturnCode=ItEvNotMine) THEN BEGIN
  1384.     OldX := Win^.GetX1;  OldY := Win^.GetY1;
  1385.     SAAWindowPtr (Win)^.CheckEvent (Ev);
  1386.     Answer := SAAWindowPtr (Win)^.GetReturnCode;
  1387.     IF Answer=ClosedWin THEN
  1388.       ReturnCode := ItFinish
  1389.     ELSE
  1390.       IF Answer=MovedWin THEN BEGIN
  1391.         SetXYRel (Win^.GetX1-OldX, Win^.GetY1-OldY);
  1392.         x1 := Win^.GetX1;  y1 := Win^.GetY1;
  1393.         x2 := Win^.GetX2;  y2 := Win^.GetY2;
  1394.         VScrollBar^.SetXYRel (Win^.GetX1-OldX,
  1395.                               Win^.GetY1-OldY);
  1396.         VScrollBar^.Show;
  1397.         HScrollBar^.SetXYRel (Win^.GetX1-OldX,
  1398.                               Win^.GetY1-OldY);
  1399.         HScrollBar^.Show;
  1400.         SetBar (ActiveItem);
  1401.         ReturnCode := ItEvAccepted;
  1402.       END;
  1403.   END;
  1404. END;
  1405.  
  1406. FUNCTION StandAlonePickList.GetWinPtr : SAAWindowPtr;
  1407. BEGIN
  1408.   GetWinPtr := SAAWindowPtr (Win);
  1409. END;
  1410.  
  1411. END.
  1412. (* ----------------------------------------------------- *)
  1413. (*                Ende von DBXITEMS.PAS                  *)
  1414. (* ----------------------------------------------------- *)
  1415.