{ SELECT.INC: Select Routines }

{==========================================================================}
{ (c) Copyright Waterline Software Developent V.O.F. 1990-1994             }
{                                                                          }
{    Waterline Software Development V.O.F.                                 }
{    Wouter Sluislaan 12                                                   }
{    1461 AC  Zuidoostbeemster                                             }
{    The Netherlands                                                       }
{                                                                          }
{ It not allowed to use this user interface in any program not owned by    }
{ the Waterline Software Development V.O.F.                                }
{ Special conditions apply to programs distributed by the Waterline        }
{ Software Development V.O.F. If the source code of any of these programs  }
{ is distributed as well, it is NOT allowed to use the user interface in   }
{ your own programs. Violators may be prosecuted!                          }
{                                                                          }
{ Please contact the Waterline Software Development V.O.F. at the above    }
{ address for your licence to use the "Ramon" user interface. You will get }
{ the most recent copy of the "Ramon" user interface and the "Ramon" user  }
{ interface expert for free. This program helps you design your user       }
{ interfaces at an instance.                                               }
{                                                                          }
{ This copyright notice should remain in this file and all files that are  }
{ part of the user interface "Ramon".                                      }
{==========================================================================}

{ History:

02-04-93 Not selectable items komen nu op een rode achtergrond te staan, dan
         is het duidelijker waarom die items bij een global tag niet getagged
         zijn.
         Met Ctrl+PgUp en Ctrl+PgDn kan nu naar het vorige en volgende
         getagde item gesprongen worden.
         Met Home en End kan nu naar het begin c.q. einde van de lijst
         gesprongen worden.

13-04-93 Als er items getagged zijn en er wordt op enter gedrukt om een
         actie ermee uit te voeren, dan wordt het cursor item niet meer in
         geel_op_blauw afgedrukt en de getaggte items in het groen. Als het
         cursor item ook getagged is, dan wordt ie groen, anders gewoon wit,
         zoals de rest niet-getagde item. Als er geen items getagged zijn,
         dan wordt ie gewoon geel na het kiezen.
         Als er vanaf nu items getagged zijn, dan komt dat in het groen en
         tussen groene haakjes te staan naast het aantal items in de lijst
         en het aantal NotAdded.

10-06-93 Zoeken met tekst invoer gemaakt. Er kan nu een string worden in
         gegeven, waarna de SelectSelect routine bij iedere wijziging van
         die string door alle items zoekt naar een match en daar de cursor
         balk op zet.

17-10-93 SelectKeysLine en SelectSetHelp toegevoegd.

11-07-94 SelectStoreCursor, SelectRestoreCursor en SelectSetCursorOnItem
         toegevoegd.

12-07-94 SelectRemoveItem toegevoegd en SelectFillWindow public gemaakt.
}

CONST MaxLenItemTekst = 80;

TYPE SelectItemRecordPtr = ^SelectItemRecord;
     SelectItemRecord    = RECORD
                                 Tekst             : STRING[MaxLenItemTekst];
                                 Nummer            : SelectItemNrType;
                                 NextItemRecordPtr : SelectItemRecordPtr;
                                 IsTagged          : BOOLEAN;
                           END;

     SelectRecordPtr = ^SelectRecord;
     SelectRecord    = RECORD
                             PrevSelectRecordPtr : SelectRecordPtr;

                             MaxLX,
                             BoxX,BoxY,
                             BoxLX,BoxLY,
                             MaxScreenLines      : XYType;
                             KopTekst            : STRING[80];
                             ItemCount           : SelectItemNrType;
                             NotAddedCount       : SelectItemNrType;
                             LastItemRecordPtr,
                             FirstItemRecordPtr  : SelectItemRecordPtr;
                             TopItem,PrevTopItem : SelectItemNrType;
                             Inside,PrevInside   : BYTE;
                             TagCount            : SelectItemNrType;
                             HelpHandle          : HelpHandleType;
                       END;


VAR CurrSelectRecordPtr : SelectRecordPtr;
    CursorItemRecordPtr : SelectItemRecordPtr;
    SelectTaggedX       : XYType;

    CursorTopItem : SelectItemNrType;
    CursorInside  : SelectItemNrType;

{--------------------------------------------------------------------------}
{ SelectDefine                                                             }
{                                                                          }
{ Deze routine pusht alle gegevens van het vorige select kader en maakt    }
{ een nieuw kader aan. De opgegeven gegevens worden alvast ingevuld, de    }
{ rest van de velden wordt geinitialiseerd. Hierna kan met SelectAddItem.. }
{ een of meerdere items toegevoegd worden.                                 }
{                                                                          }
PROCEDURE SelectDefine (X,Y,LX,LY : XYType; Title : STRING);

VAR NewSelectRecordPtr : SelectRecordPtr;

BEGIN
     GetMem (NewSelectRecordPtr,SizeOf (SelectRecord));

     WITH NewSelectRecordPtr^ DO
     BEGIN
          PrevSelectRecordPtr:=CurrSelectRecordPtr;
          BoxX:=X; BoxY:=Y;
          BoxLX:=LX; BoxLY:=4; { ivm header }
          MaxLX:=Video.Cols-BoxX-1;
          MaxScreenLines:=LY;
          KopTekst:=' '+Title+' ';
          ItemCount:=0;
          NotAddedCount:=0;
          LastItemRecordPtr:=NIL;
          FirstItemRecordPtr:=NIL;

          IF (BoxLX-2 < Length (KopTekst)) THEN BoxLX:=Length (KopTekst)+2;
          IF (BoxLX > MaxLX) THEN BoxLX:=MaxLX;
          IF (MaxScreenLines < 4) THEN MaxScreenLines:=4; { ivm de header }

          TopItem:=0; PrevTopItem:=0;
          Inside:=1;  PrevInside:=0;
          TagCount:=0;

          HelpHandle:=0;
     END; { with }

     CurrSelectRecordPtr:=NewSelectRecordPtr;
END;


{--------------------------------------------------------------------------}
{ SelectSetHelp                                                            }
{                                                                          }
{ Met deze routine kan de help voor dit select window ingesteld worden.    }
{                                                                          }
PROCEDURE SelectSetHelp (Handle : HelpHandleType);
BEGIN
     IF (CurrSelectRecordPtr <> NIL) THEN
        CurrSelectRecordPtr^.HelpHandle:=Handle;
END;


{--------------------------------------------------------------------------}
{ SelectAddItemAtTop                                                       }
{                                                                          }
{ Met deze routine kan een item aan het begin van de lijst worden toege-   }
{ voegd. Alleen als er genoeg geheugen vrij is (minimaal 4000 bytes), dan  }
{ wordt het item toegevoegd, anders wordt de NotAddedCount verhoogd.       }
{                                                                          }
PROCEDURE SelectAddItemAtTop (ItemTekst : STRING; ItemNr : SelectItemNrType);

VAR NewItemRecordPtr : SelectItemRecordPtr;

BEGIN
     IF (MemAvail < 4000) THEN
     BEGIN
          Inc (CurrSelectRecordPtr^.NotAddedCount);
          Exit;
     END;

     GetMem (NewItemRecordPtr,SizeOf (SelectItemRecord));

     WITH NewItemRecordPtr^ DO
     BEGIN
          Tekst:=ItemTekst;
          Nummer:=ItemNr;
          NextItemRecordPtr:=CurrSelectRecordPtr^.FirstItemRecordPtr;
          IsTagged:=FALSE;
     END; { with }

     WITH CurrSelectRecordPtr^ DO
     BEGIN
          Inc (ItemCount);

          IF (BoxLX-3 < Length (ItemTekst)) THEN BoxLX:=Length (ItemTekst)+3;
          IF (BoxLX > MaxLX) THEN BoxLX:=MaxLX;
          IF (BoxLY < MaxScreenLines) THEN Inc (BoxLY);

          FirstItemRecordPtr:=NewItemRecordPtr;

          IF (LastItemRecordPtr = NIL) THEN
             LastItemRecordPtr:=FirstItemRecordPtr;
     END; { with }
END;


{--------------------------------------------------------------------------}
{ SelectAddItemAtBottom                                                    }
{                                                                          }
{ Met deze routine kan een item aan de staart van de lijst worden toege-   }
{ voegd. Alleen als er genoeg geheugen vrij is (minimaal 4000 bytes), dan  }
{ wordt het item toegevoegd, anders wordt de NotAddedCount verhoogd.       }
{                                                                          }
PROCEDURE SelectAddItemAtBottom (ItemTekst : STRING; ItemNr : SelectItemNrType);

VAR NewItemRecordPtr  : SelectItemRecordPtr;
    ZoekItemRecordPtr : SelectItemRecordPtr;

BEGIN
     IF (MemAvail < 4000) THEN
     BEGIN
          Inc (CurrSelectRecordPtr^.NotAddedCount);
          Exit;
     END;

     GetMem (NewItemRecordPtr,SizeOf (SelectItemRecord));

     WITH NewItemRecordPtr^ DO
     BEGIN
          Tekst:=ItemTekst;
          Nummer:=ItemNr;
          NextItemRecordPtr:=NIL;
          IsTagged:=FALSE;
     END; { with }

     WITH CurrSelectRecordPtr^ DO
     BEGIN
          Inc (ItemCount);

          IF (BoxLX-3 < Length (ItemTekst)) THEN BoxLX:=Length (ItemTekst)+3;
          IF (BoxLX > MaxLX) THEN BoxLX:=MaxLX;
          IF (BoxLY < MaxScreenLines) THEN Inc (BoxLY);

          IF (FirstItemRecordPtr = NIL) THEN
          BEGIN
               { is het eerste toegevoegde item }
               FirstItemRecordPtr:=NewItemRecordPtr;
               LastItemRecordPtr:=NewItemRecordPtr;
          END ELSE
          BEGIN
               { niet het eerste toegevoegde item }
               IF (LastItemRecordPtr = NIL) OR (LastItemRecordPtr^.NextItemRecordPtr <> NIL) THEN
               BEGIN
                    { volgens de oude methode }
                    ZoekItemRecordPtr:=FirstItemRecordPtr;

                    WHILE (ZoekItemRecordPtr^.NextItemRecordPtr <> NIL) DO
                          ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;

                    ZoekItemRecordPtr^.NextItemRecordPtr:=NewItemRecordPtr;
                    LastItemRecordPtr:=NewItemRecordPtr;
               END ELSE
               BEGIN
                    { snel aan het einde toevoegen }
                    LastItemRecordPtr^.NextItemRecordptr:=NewItemRecordPtr;
                    NewItemRecordPtr:=LastItemRecordPtr;
               END;
          END;
     END; { with }
END;


{--------------------------------------------------------------------------}
{ SelectAddItemSorted                                                      }
{                                                                          }
{ Deze routine doet bijna hetzelfde als de vorige met dien verstande dat   }
{ de items nu gesorteerd worden opgeslagen en dus in de lijst komen. Er    }
{ wordt niet naar het caps gekeken, het beste kunnen alle items dus eerst  }
{ in hoofd of kleine letters omgezet worden.                               }
{                                                                          }
PROCEDURE SelectAddItemSorted (ItemTekst : STRING; ItemNr : SelectItemNrType);

VAR NewItemRecordPtr,
    PrevItemRecordPtr,
    ZoekItemRecordPtr : SelectItemRecordPtr;

BEGIN
     IF (MemAvail < 4000) THEN
     BEGIN
          Inc (CurrSelectRecordPtr^.NotAddedCount);
          Exit;
     END;

     GetMem (NewItemRecordPtr,SizeOf (SelectItemRecord));

     WITH NewItemRecordPtr^ DO
     BEGIN
          Tekst:=ItemTekst;
          Nummer:=ItemNr;
          NextItemRecordPtr:=NIL;
          IsTagged:=FALSE;
     END; { with }

     WITH CurrSelectRecordPtr^ DO
     BEGIN
          Inc (ItemCount);

          IF (BoxLX-3 < Length (ItemTekst)) THEN BoxLX:=Length (ItemTekst)+3;
          IF (BoxLX > MaxLX) THEN BoxLX:=MaxLX;
          IF (BoxLY < MaxScreenLines) THEN Inc (BoxLY);

          IF (FirstItemRecordPtr = NIL) THEN
          BEGIN
               FirstItemRecordPtr:=NewItemRecordPtr;
               LastItemRecordPtr:=NewItemRecordPtr;
          END ELSE
          BEGIN
               PrevItemRecordPtr:=NIL;
               ZoekItemRecordPtr:=FirstItemRecordPtr;

               WHILE (ZoekItemRecordPtr <> NIL) AND
                     (NewItemRecordPtr^.Tekst > ZoekItemRecordPtr^.Tekst) DO
               BEGIN
                    PrevItemRecordPtr:=ZoekItemRecordPtr;
                    ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;
               END;

               IF (PrevItemRecordPtr = NIL) THEN
               BEGIN
                    { aan het begin toevoegen }
                    NewItemRecordPtr^.NextItemRecordPtr:=FirstItemRecordPtr;
                    FirstItemRecordPtr:=NewItemRecordPtr;
                    { laatste wijzigt niet }
               END ELSE
               BEGIN
                    NewItemRecordPtr^.NextItemRecordPtr:=ZoekItemRecordPtr;
                    PrevItemRecordPtr^.NextItemRecordPtr:=NewItemRecordPtr;

                    IF (ZoekItemRecordPtr = NIL) THEN
                       LastItemRecordptr:=NewItemRecordPtr;
               END;
          END; { not first }
     END; { with }
END;


{--------------------------------------------------------------------------}
{ SelectAddItemSortedConvert                                               }
{                                                                          }
{ Deze routine slaat de items ook gesorteerd op, maar dan op achternaam.   }
{ Verder kan er een afkortingscode vooraan staan, die wordt dan ook        }
{ overgeslagen.                                                            }
{                                                                          }
PROCEDURE SelectAddItemSortedConvert (ItemTekst : STRING; ItemNr : SelectItemNrType; Convert : SelectConvertFunc);

VAR NewItemRecordPtr,
    PrevItemRecordPtr,
    ZoekItemRecordPtr : SelectItemRecordPtr;
    Converted         : STRING[MaxLenItemTekst];

BEGIN
     IF (MemAvail < 4000) THEN
     BEGIN
          Inc (CurrSelectRecordPtr^.NotAddedCount);
          Exit;
     END;

     GetMem (NewItemRecordPtr,SizeOf (SelectItemRecord));

     WITH NewItemRecordPtr^ DO
     BEGIN
          Tekst:=ItemTekst;
          Nummer:=ItemNr;
          NextItemRecordPtr:=NIL;
          IsTagged:=FALSE;
     END; { with }

     WITH CurrSelectRecordPtr^ DO
     BEGIN
          Inc (ItemCount);

          IF (BoxLX-3 < Length (ItemTekst)) THEN BoxLX:=Length (ItemTekst)+3;
          IF (BoxLX > MaxLX) THEN BoxLX:=MaxLX;
          IF (BoxLY < MaxScreenLines) THEN Inc (BoxLY);

          IF (FirstItemRecordPtr = NIL) THEN
          BEGIN
               FirstItemRecordPtr:=NewItemRecordPtr;
               LastItemRecordPtr:=NewItemRecordPtr;
          END ELSE
          BEGIN
               PrevItemRecordPtr:=NIL;
               ZoekItemRecordPtr:=FirstItemRecordPtr;

               Converted:=Convert (NewItemRecordPtr^.Tekst);
               WHILE (ZoekItemRecordPtr <> NIL) AND
                     (Converted > Convert (ZoekItemRecordPtr^.Tekst)) DO
               BEGIN
                    PrevItemRecordPtr:=ZoekItemRecordPtr;
                    ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;
               END;

               IF (PrevItemRecordPtr = NIL) THEN
               BEGIN
                    { aan het begin toevoegen }
                    NewItemRecordPtr^.NextItemRecordPtr:=FirstItemRecordPtr;
                    FirstItemRecordPtr:=NewItemRecordPtr;
                    { laatste item wijzigt niet }
               END ELSE
               BEGIN
                    { midden in lijst of aan einde lijst toevoegen }
                    NewItemRecordPtr^.NextItemRecordPtr:=ZoekItemRecordPtr;
                    PrevItemRecordPtr^.NextItemRecordPtr:=NewItemRecordPtr;

                    { eventueel nieuw einde instellen }
                    IF (ZoekItemRecordPtr = NIL) THEN
                       LastItemRecordPtr:=NewItemRecordPtr;
               END;
          END; { not first }
     END; { with }
END;


{--------------------------------------------------------------------------}
{ SelectRemoveItem                                                         }
{                                                                          }
{ Met deze routine kan een item uit de select lijst verwijderd worden.     }
{ Merk op dat deze routine het window op het scherm aan kan passen. In     }
{ dat geval wordt WindowPop aangeroepen en moet SelectShow dus als laatste }
{ zijn window op de stack hebben gezet!                                    }
{                                                                          }
PROCEDURE SelectRemoveItem (ItemNr : SelectItemNrType);

VAR PrevItemRecordPtr,
    HulpItemRecordPtr : SelectItemRecordPtr;

BEGIN
     IF (CurrSelectRecordPtr = NIL) THEN
        Exit; { geen SelectDefine gehad }

     WITH CurrSelectRecordPtr^ DO
     BEGIN
          PrevItemRecordPtr:=NIL;
          HulpItemRecordPtr:=FirstItemRecordPtr;

          WHILE (HulpItemRecordPtr <> NIL) DO
                WITH HulpItemRecordPtr^ DO
                BEGIN
                     IF (Nummer = ItemNr) THEN
                        Break; { uit de while }

                     PrevItemRecordPtr:=HulpItemRecordPtr;
                     HulpItemRecordPtr:=NextItemRecordPtr;
                END; { with, while }

          IF (HulpItemRecordPtr = NIL) THEN
             Exit; { niet gevonden }

          { FirstItemRecordPtr updaten }
          { controleer of het te verwijderen item de eerste is }
          IF (PrevItemRecordPtr = NIL) THEN
             FirstItemRecordPtr:=HulpItemRecordPtr^.NextItemRecordPtr
          ELSE
              { vorige chainen aan onze opvolger }
              PrevItemRecordPtr^.NextItemRecordPtr:=HulpItemRecordPtr^.NextItemRecordPtr;

          { LastItemRecordPtr updaten }
          { als het te verwijderen item de laatste is, dan wordt de }
          { new laatste PrevItemRecordPtr^.                         }
          IF (LastItemRecordPtr = HulpItemRecordPtr) THEN
             LastItemRecordPtr:=PrevItemRecordPtr;

          { nu dit item weggooien }
          IF HulpItemRecordPtr^.IsTagged THEN
             Dec (TagCount);

          { geheugen van dit item vrijgeven }
          FreeMem (HulpItemRecordPtr,SizeOf (SelectItemRecord));

          { nu een item minder in de lijst }
          Dec (ItemCount);

          { controleer of het aantal regels van de box misschien }
          { minder moet worden.                                  }
          IF (BoxLY-4 > ItemCount) THEN
          BEGIN
               Dec (BoxLY);
               WindowPop; { window van het scherm verwijderen }

               WindowPush (BoxX,BoxY,BoxLX,BoxLY);
               BoxDraw (Double,BoxX,BoxY,BoxLX,BoxLY);
               WriteXY (BoxX,BoxY+2,TL+RepChar (BoxLX-2,HO)+TR);
               WriteXY (BoxX+(BoxLX DIV 2)-(Length (KopTekst) DIV 2),BoxY+1,KopTekst);
          END;
     END; { with }
END;


{--------------------------------------------------------------------------}
{ SelectItemCount                                                          }
{                                                                          }
{ Deze routine geeft terug hoeveel items er in de lijst zijn opgeslagen.   }
{ Op deze manier kan getest worden of er uberhaupt wel items zijn voordat  }
{ een call naar SelectShow geplaatst wordt. Die gaat kankeren als er geen  }
{ records zijn!                                                            }
{                                                                          }
FUNCTION SelectItemCount : SelectItemNrType;
BEGIN
     SelectItemCount:=CurrSelectRecordPtr^.ItemCount;
END;


{--------------------------------------------------------------------------}
{ SelectTagCount                                                           }
{                                                                          }
{ Deze routine geeft terug hoeveel items in de lijst getagged zijn.        }
{                                                                          }
FUNCTION SelectTagCount : SelectItemNrType;
BEGIN
     SelectTagCount:=CurrSelectRecordPtr^.TagCount;
END;


{--------------------------------------------------------------------------}
{ SelectGetTaggedItemNr                                                    }
{                                                                          }
{ Met deze routine kan het ItemNr van een van de getagde items opgehaald   }
{ worden. Als argument met het volgnummer tussen 1 en SelectTagCount       }
{ opgegeven worden.
{                                                                          }
FUNCTION SelectGetTaggedItemNr (TagNr : SelectItemNrType) : SelectItemNrType;

VAR ZoekItemRecordPtr : SelectItemRecordPtr;

BEGIN
     ZoekItemRecordPtr:=CurrSelectRecordPtr^.FirstItemRecordPtr;

     WHILE (ZoekItemRecordPtr <> NIL) AND (TagNr > 0) DO
     BEGIN
          IF ZoekItemRecordPtr^.IsTagged THEN
          BEGIN
               Dec (TagNr);
               IF (TagNr = 0) THEN
                  SelectGetTaggedItemNr:=ZoekItemRecordPtr^.Nummer;
          END;

          ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;
     END;
END;


{--------------------------------------------------------------------------}
{ SelectGetItemTekst                                                       }
{                                                                          }
{ Met deze routine kan de tekst van een van de opgeslagen items opgehaald  }
{ worden. Als een niet bestaand ItemNr opgegeven wordt, dan wordt een lege }
{ string terug gegeven. Als er meerdere records met hetzelfde nummer zijn, }
{ dan wordt de tekst van de eerste terug gegeven.                          }
{                                                                          }
FUNCTION SelectGetItemTekst (ItemNr : SelectItemNrType) : STRING;

VAR ItemTekst         : STRING;
    ZoekItemRecordPtr : SelectItemRecordPtr;

BEGIN
     ItemTekst:='';
     ZoekItemRecordPtr:=CurrSelectRecordPtr^.FirstItemRecordPtr;
     WHILE (ZoekItemRecordPtr <> NIL) AND (ItemTekst = '') DO
     BEGIN
          IF (ZoekItemRecordPtr^.Nummer = ItemNr) THEN
             ItemTekst:=ZoekItemRecordPtr^.Tekst;

          ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;
     END;

     SelectGetItemTekst:=ItemTekst;
END;


{--------------------------------------------------------------------------}
{ SelectSetItemTekst                                                       }
{                                                                          }
{ Met deze routine kan de tekst van een item vervangen worden. Als het     }
{ ItemNr niet bestaat, dan gebeurt er niets. Als er meerder items zijn met }
{ hetzelfde nummer, dan wordt de tekst van alle items vervangen.           }
{                                                                          }
PROCEDURE SelectSetItemTekst (ItemTekst : STRING; ItemNr : SelectItemNrType);

VAR ZoekItemRecordPtr : SelectItemRecordPtr;

BEGIN
     ZoekItemRecordPtr:=CurrSelectRecordPtr^.FirstItemRecordPtr;
     WHILE (ZoekItemRecordPtr <> NIL) DO
     BEGIN
          IF (ZoekItemRecordPtr^.Nummer = ItemNr) THEN
             ZoekItemRecordPtr^.Tekst:=AddUpWithSpaces (CurrSelectRecordPtr^.BoxLX-3,ItemTekst);

          ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;
     END;
END;


{--------------------------------------------------------------------------}
{ SelectStoreCursor                                                        }
{                                                                          }
{ Deze routine slaat alle info op die nodig is op de cursor op de          }
{ opgegeven regel te zetten.                                               }
{                                                                          }
PROCEDURE SelectStoreCursor;
BEGIN
     IF (CurrSelectRecordPtr = NIL) THEN
        Exit;

     WITH CurrSelectRecordPtr^ DO
     BEGIN
          CursorTopItem:=TopItem;
          CursorInside:=Inside;
     END; { with }
END;


{--------------------------------------------------------------------------}
{ SelectRestoreCursor                                                      }
{                                                                          }
{ Deze routine zet de cursor terug op de regel die met SelectStoreCursor   }
{ is opgeslagen.                                                           }
{                                                                          }
PROCEDURE SelectRestoreCursor;
BEGIN
     IF (CurrSelectRecordPtr = NIL) THEN
        Exit;

     WITH CurrSelectRecordPtr^ DO
     BEGIN
          { controleer cursor positie binnen grenzen }
          IF (CursorInside < 1) THEN CursorInside:=1;
          IF (CursorInside > BoxLY-4) THEN
             CursorInside:=BoxLY-4;

          IF (CursorTopItem+CursorInside > ItemCount) THEN
             CursorTopItem:=ItemCount-(BoxLY-4);

          TopItem:=CursorTopItem;
          PrevTopItem:=0; { onmogelijke waarde }
          Inside:=CursorInside;
          PrevInside:=0;
     END; { with }
END;


{--------------------------------------------------------------------------}
{ SelectSetCursorOnItem                                                    }
{                                                                          }
{ Met deze routine kan de cursor een van de opgegeven items gezet worden.  }
{ De hele lijst met items wordt doorlopen op zoek naar het item. Er wordt  }
{ geprobeerd de cursor in het midden van het lijstwindow te houden, maar   }
{ als dat niet lukt wordt deze omhoog of omlaag gehaald.                   }
{                                                                          }
PROCEDURE SelectSetCursorOnItem (ItemNr : SelectItemNrType);

VAR IndexNr           : SelectItemNrType; { vanaf het begin }
    ZoekItemRecordPtr : SelectItemRecordPtr;

BEGIN
     WITH CurrSelectRecordPtr^ DO
     BEGIN
          IndexNr:=1;
          ZoekItemRecordPtr:=FirstItemRecordPtr;
          WHILE (ZoekItemRecordPtr <> NIL) AND (ZoekItemRecordPtr^.Nummer <> ItemNr) DO
          BEGIN
               Inc (IndexNr);
               ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;
          END;

          IF (ZoekItemRecordPtr = NIL) THEN
             Exit;

          Inside:=(BoxLY-4) DIV 2; { is het midden van het scherm }

          PrevInside:=0;
          PrevTopItem:=65535; { onmogelijk nummer }

          IF (IndexNr <= Inside) THEN
          BEGIN
               TopItem:=0;
               Inside:=IndexNr;
               Exit;
          END;

          IndexNr:=IndexNr-Inside;
          TopItem:=IndexNr;

          WHILE (TopItem+(BoxLY-4) > ItemCount) DO
          BEGIN
               Dec (TopItem);
               Inc (Inside);
          END;
     END;
END;


{--------------------------------------------------------------------------}
{ PrintTaggedCount                                                         }
{                                                                          }
{ Deze routine drukt naast de ItemsCount en NotAddedCount het aantal       }
{ getagde items af. Dit komt in groen en tussen haakjes te staan.          }
{                                                                          }
PROCEDURE PrintTagCount;

VAR HulpString : STRING[9];
    HulpLen    : BYTE;

BEGIN
     WITH CurrSelectRecordPtr^ DO
     BEGIN
          IF (SelectTagCount > 0) THEN
          BEGIN
               HulpString:=' ('+Word2String (SelectTagCount)+') ';
               HulpLen:=Length (HulpString);
               WriteXYC (SelectTaggedX,BoxY,cBoxDataTagged,HulpString);
          END ELSE
              HulpLen:=0;

          WriteXYC (SelectTaggedX+HulpLen+1,BoxY,cBoxBack,RepChar (BoxLX-(SelectTaggedX-BoxX)-HulpLen-2,HO));
     END;
END;


{--------------------------------------------------------------------------}
{ DoMultipleTag                                                            }
{                                                                          }
{ Met deze routine kan een tag of untag uitgevoerd worden om meerdere      }
{ items tegelijk. Welke items wordt bepaald door het Tag argument.         }
{                                                                          }
PROCEDURE DoMultipleTag (NewTagValue : BOOLEAN);

CONST Xb = 30;
      Yb = 10;
      Xl = 20;
      Yl = 5;

VAR TagItemRecordPtr : SelectItemRecordPtr;
    TagArgument      : STRING;

BEGIN
{ get tag argument }
     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     IF (NewTagValue = FALSE) THEN WriteXY (Xb+2,Yb+1,'Untag argument?')
                              ELSE WriteXY (Xb+2,Yb+1,'Tag argument?');

     FieldPushAll;
     FieldInit;
     TagArgument:=Spaces (MaxLenItemTekst);

     FieldDefineLongOne (1,Xb+2,Yb+3,MaxLenItemTekst,16,0,0,@TagArgument,RepChar (MaxLenItemTekst,'$'));
     FieldEditDirect;

     IF (Key = kRet) THEN
     BEGIN
          WHILE (TagArgument <> '') AND
                (TagArgument[Length (TagArgument)] = ' ')
          DO
            Delete (TagArgument,Length (TagArgument),1);

          TagArgument:=UpCaseString (TagArgument);

          TagItemRecordPtr:=CurrSelectRecordPtr^.FirstItemRecordPtr;
          WHILE (TagItemRecordPtr <> NIL) DO
                WITH TagItemRecordPtr^ DO
                BEGIN
                     IF (Nummer < 65000) AND
                        ((TagArgument = '') OR
                         (Pos (TagArgument,UpCaseString (Tekst)) > 0)) THEN
                     BEGIN
                          IF IsTagged THEN Dec (CurrSelectRecordPtr^.TagCount);
                          IsTagged:=NewTagValue;
                          IF IsTagged THEN Inc (CurrSelectRecordPtr^.TagCount);
                     END;

                     TagItemRecordPtr:=NextItemRecordPtr;
                END;
     END;

     FieldPopAll;
     WindowPop;
     PrintTagCount;
END;


{--------------------------------------------------------------------------}
{ SelectSetActive                                                          }
{                                                                          }
{ Deze routine tekent het kader opnieuw in de gele (actieve) kleur en      }
{ schrijft daar ook de header in het geel in. Als laatste wordt de cursor  }
{ regel (weer) in het grijs afgedrukt.                                     }
{                                                                          }
PROCEDURE SelectSetActive;

VAR Msg : STRING[12];

BEGIN
     WITH CurrSelectRecordPtr^ DO
     BEGIN
          SetLines (Double);
          BoxSetActive (BoxX,BoxY,BoxLX,BoxLY);
          WriteXY (BoxX,BoxY+2,TL+RepChar (BoxLX-2,HO)+TR);
          WriteXY (BoxX+(BoxLX DIV 2)-(Length (KopTekst) DIV 2),BoxY+1,KopTekst);

          Msg:=' '+Word2String (ItemCount);
          IF (NotAddedCount > 0) THEN
             Msg:=Msg+'/'+Word2String (ItemCount+NotAddedCount);
          WriteXY (BoxX+1,BoxY,Msg+' ');
          SelectTaggedX:=BoxX+1+Length (Msg);

          ChangeColor (BoxX+2,BoxY+2+Inside,BoxLX-3,cFieldCursor);
     END;

     PrintTagCount;
END;


{--------------------------------------------------------------------------}
{ SelectSetInactive                                                        }
{                                                                          }
{ Deze routine tekent het kader opnieuw in de witte (inactieve) kleur en   }
{ schrijft daar ook de header in het wit in. Als laatste wordt de cursor   }
{ regel geel gemaakt.                                                      }
{                                                                          }
PROCEDURE SelectSetInactive;

VAR InActiveColor : ColorSet;

BEGIN
     WITH CurrSelectRecordPtr^ DO
     BEGIN
          BoxSetInactive (BoxX,BoxY,BoxLX,BoxLY);
          WriteXY (BoxX,BoxY+2,TL+RepChar (BoxLX-2,HO)+TR);
          WriteXY (BoxX+(BoxLX DIV 2)-(Length (KopTekst) DIV 2),BoxY+1,KopTekst);

          InActiveColor:=cBoxBack;                  { single selected item }
          IF (SelectTagCount > 0) THEN
             IF (CursorItemRecordPtr^.IsTagged) THEN
                InActiveColor:=cBoxDataTagged       { deze is ook getagged }
             ELSE
                 InActiveColor:=cBoxData;    { rest is getagged, deze niet }

          ChangeColor (BoxX+2,BoxY+2+Inside,BoxLX-3,InActiveColor);
     END;
END;


{--------------------------------------------------------------------------}
{ SelectShow                                                               }
{                                                                          }
{ Deze routine zet de select lijst op het scherm.                          }
{                                                                          }
PROCEDURE SelectShow;

VAR LpItemRecordPtr : SelectItemRecordPtr;

BEGIN
     WITH CurrSelectRecordPtr^ DO
     BEGIN
          IF (NotAddedCount > 0) THEN
             Error ('Not enough memory to hold all items, this is a partial list!');

{ controle aanwezigheid records }
          IF (FirstItemRecordPtr = NIL) THEN
             Error ('No records; Use SelectItemCount to test!');

{ alle records op lengte maken }
          LpItemRecordPtr:=FirstItemRecordPtr;
          WHILE (LpItemRecordPtr <> NIL) DO
          BEGIN
               IF (Length (LpItemRecordPtr^.Tekst) <> BoxLX-3) THEN
                  LpItemRecordPtr^.Tekst:=AddUpWithSpaces (BoxLX-3,LpItemRecordPtr^.Tekst);

               LpItemRecordPtr:=LpItemRecordPtr^.NextItemRecordPtr;
          END;

          WindowPush (BoxX,BoxY,BoxLX,BoxLY);
          BoxDraw (Double,BoxX,BoxY,BoxLX,BoxLY);
          WriteXY (BoxX,BoxY+2,TL+RepChar (BoxLX-2,HO)+TR);
          WriteXY (BoxX+(BoxLX DIV 2)-(Length (KopTekst) DIV 2),BoxY+1,KopTekst);
     END;
END;


{--------------------------------------------------------------------------}
{ SelectErase                                                              }
{                                                                          }
{ Deze routine geeft al het aangevraagde geheugen voor deze select lijst   }
{ weer vrij. Ook wordt het window van het scherm verwijderd.               }
{                                                                          }
PROCEDURE SelectErase;

VAR EraseSelectRecordPtr : SelectRecordPtr;
    EraseItemRecordPtr   : SelectItemRecordPtr;

BEGIN
     WindowPop;                                       { window verwijderen }

{ item records verwijderen }
     WHILE (CurrSelectRecordPtr^.FirstItemRecordPtr <> NIL) DO
     BEGIN
          EraseItemRecordPtr:=CurrSelectRecordPtr^.FirstItemRecordPtr;
          CurrSelectRecordPtr^.FirstItemRecordPtr:=EraseItemRecordPtr^.NextItemRecordPtr;
          FreeMem (EraseItemRecordPtr,SizeOf (SelectItemRecord));
     END;

{ select record }
     EraseSelectRecordPtr:=CurrSelectRecordPtr;
     CurrSelectRecordPtr:=CurrSelectRecordPtr^.PrevSelectRecordPtr;
     FreeMem (EraseSelectRecordPtr,SizeOf (SelectRecord));
END;


{--------------------------------------------------------------------------}
{ SelectFillWindow                                                         }
{                                                                          }
{ Deze routine drukt de teksten van de items in de al getekende box af.    }
{ TopItem bepaald welk item bovenaan komt te staan.                        }
{                                                                          }
PROCEDURE SelectFillWindow;

VAR ZoekItemRecordPtr : SelectItemRecordPtr;
    ZoekLp            : SelectItemNrType;
    PrintLp           : XYType;

BEGIN
     WITH CurrSelectRecordPtr^ DO
     BEGIN
          ZoekItemRecordPtr:=FirstItemRecordPtr;

          FOR ZoekLp:=1 TO TopItem DO
              ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;

          FOR PrintLp:=1 TO BoxLY-4 DO
          BEGIN
               SetColor (cBoxData);

               IF (PrintLp = 1) THEN
                  IF (TopItem <> 0) THEN
                     WriteXY (BoxX+1,BoxY+PrintLp+2,#30)
                  ELSE
                      WriteXY (BoxX+1,BoxY+PrintLp+2,'³');

               IF (PrintLp = BoxLY-4) THEN
                  IF (TopItem+BoxLY-4 < ItemCount) THEN
                     WriteXY (BoxX+1,BoxY+PrintLp+2,#31)
                  ELSE
                      WriteXY (BoxX+1,BoxY+PrintLp+2,'³');

               IF (PrintLp <> 1) AND (PrintLp <> BoxLY-4) THEN
                  WriteXY (BoxX+1,BoxY+PrintLp+2,'³');

               IF ZoekItemRecordPtr^.IsTagged THEN
                  IF (PrintLp = Inside) THEN SetColor (cFieldCursorTagged)
                                        ELSE SetColor (cBoxDataTagged)
               ELSE
                   IF (PrintLp = Inside) THEN SetColor (cFieldCursor)
                   ELSE
                       IF (ZoekItemRecordPtr^.Nummer >= 65000) THEN
                          SetColor (cNotTagable);

               WriteXY (BoxX+2,BoxY+PrintLp+2,Copy (ZoekItemRecordPtr^.Tekst,1,BoxLX-3));

               IF (PrintLp = Inside) THEN
                  CursorItemRecordPtr:=ZoekItemRecordPtr; { ivm taggen }

               ZoekItemRecordPtr:=ZoekItemRecordPtr^.NextItemRecordPtr;
          END; { for }
     END; { with }
END;


{--------------------------------------------------------------------------}
{ SelectSelect                                                             }
{                                                                          }
{ Met deze routine kan een selectie uit de in de lijst aanwezige items.    }
{                                                                          }
FUNCTION SelectSelect (AllowTag : TagType) : SelectItemNrType;

VAR Quit     : BOOLEAN;
    ForceKey,
    PrevKey  : KeyType;
    PrevNr,
    ItemNr   : SelectItemNrType;

    SearchItemRecordPtr : SelectItemRecordPtr;
    Search              : STRING;
    ReSearch            : BOOLEAN;

BEGIN
     PushKeysLine;
     IF (AllowTag = NoTag) THEN WriteKeysLine (SelectNoTagKeysLine)
                           ELSE WriteKeysLine (SelectTagKeysLine);

     WITH CurrSelectRecordPtr^ DO
     BEGIN
          Search:='';
          ReSearch:=FALSE;

          SelectSetActive;

          ForceKey:=kUnknown;
          PrevKey:=kUnknown;

{ de volgende regel zorgt ervoor dat bij het aanroepen van SelectSelect   }
{ de CursorItemPtr geupdate wordt. Anders zou na het verwijderen van de   }
{ vorige Select Lijst de CurrsorItemPtr niet goed staan en na een directe }
{ kRet het Nummer van de Item verkeerd opgehaald worden.  Bugje dd 160293 }
          PrevInside:=Inside+1;

          Quit:=FALSE;
          REPEAT
                IF ReSearch THEN
                BEGIN
                     SearchItemRecordPtr:=CurrSelectRecordPtr^.FirstItemRecordPtr;
                     Inside:=1;
                     TopItem:=0;

                     REPEAT
                           IF (UpCaseString (Copy (SearchItemRecordPtr^.Tekst,1,Length (Search))) = Search) THEN
                              Break; { repeat/until }

                           IF (Inside < BoxLY-4) THEN
                              Inc (Inside)
                           ELSE
                               Inc (TopItem);

                           SearchItemRecordPtr:=SearchItemRecordPtr^.NextItemRecordPtr;

                     UNTIL (SearchItemRecordPtr = NIL);

                     IF (SearchItemRecordPtr = NIL) THEN
                     BEGIN
                          Inside:=PrevInside;
                          TopItem:=PrevTopItem;
                          Delete (Search,Length (Search),1);
                          Write (#7);
                     END;

                     ReSearch:=FALSE;
                END;

                IF (PrevInside <> Inside) OR
                   (PrevTopItem <> TopItem) THEN
                BEGIN
                     SelectFillWindow;

                     PrevInside:=Inside;
                     PrevTopItem:=TopItem;
                END;

                IF (ForceKey = kUnknown) THEN
                BEGIN
                     IF (Search <> '') THEN
                     BEGIN
                          CursorGotoXY (BoxX+1+Length (Search),BoxY+2+Inside);
                          CursorOn;
                          Key:=ReadKey;
                          CursorOff;
                     END ELSE
                         Key:=ReadKey
                END ELSE
                BEGIN
                     Key:=ForceKey;
                     ForceKey:=kUnknown;
                END;

                IF (Key IN [kF5,kF6,kF7]) AND (AllowTag = NoTag) THEN
                   Key:=kUnknown;

                CASE Key OF
                     kUp : BEGIN
                                IF (Inside > 1) THEN
                                    Dec (Inside)
                                 ELSE
                                     IF (Inside = 1) AND (TopItem > 0) THEN
                                        Dec (TopItem);

                                 Search:='';
                           END;

                     kDown : BEGIN
                                  IF (Inside < BoxLY-4) THEN
                                     Inc (Inside)
                                  ELSE
                                      IF (Inside = BoxLY-4) AND (TopItem < ItemCount-BoxLY+4) THEN
                                         Inc (TopItem);

                                  Search:='';
                             END;

                     kCtrlPgUp : BEGIN
                                      PrevNr:=0; { nog niets gevonden }
                                      ItemNr:=1;

                                      CursorItemRecordPtr:=FirstItemRecordPtr;
                                      WHILE (CursorItemRecordPtr <> NIL) AND
                                            (ItemNr < TopItem+Inside) DO
                                      BEGIN
                                           IF (CursorItemRecordPtr^.IsTagged) THEN
                                              PrevNr:=ItemNr;

                                           CursorItemRecordPtr:=CursorItemRecordPtr^.NextItemRecordPtr;
                                           Inc (ItemNr);
                                      END;

                                      IF (PrevNr <> 0) THEN
                                         WHILE (TopItem+InSide <> PrevNr) DO
                                               IF (InSide > 1) THEN
                                                  Dec (InSide)
                                               ELSE
                                                   IF (InSide = 1) AND (TopItem > 0) THEN
                                                      Dec (TopItem);

                                      Search:='';
                                 END;

                     kCtrlPgDn : BEGIN
                                      REPEAT
                                            IF (Inside < BoxLY-4) THEN
                                            BEGIN
                                                 Inc (Inside);
                                                 CursorItemRecordPtr:=CursorItemRecordPtr^.NextItemRecordPtr;
                                            END ELSE
                                                IF (Inside = BoxLY-4) AND (TopItem < ItemCount-BoxLY+4) THEN
                                                BEGIN
                                                     Inc (TopItem);
                                                     CursorItemRecordPtr:=CursorItemRecordPtr^.NextItemRecordPtr;
                                                END;

                                      UNTIL (CursorItemRecordPtr^.IsTagged) OR
                                            ((InSide = BoxLY-4) AND (TopItem = ItemCount-BoxLY+4));

                                      IF (CursorItemRecordPtr <> NIL) AND
                                         (CursorItemRecordPtr^.IsTagged = FALSE) THEN
                                      BEGIN
                                           InSide:=PrevInSide;
                                           TopItem:=PrevTopItem;
                                           PrevTopItem:=TopItem+1; { force redraw }
                                      END;

                                      Search:='';
                                 END;

                     kHome : BEGIN
                                  InSide:=1;
                                  TopItem:=0;
                                  PrevTopItem:=1; { force redraw }
                                  Search:='';
                             END;

                     kEnd  : BEGIN
                                  InSide:=BoxLY-4;
                                  TopItem:=ItemCount-BoxLY+4;
                                  PrevTopItem:=0; { force redraw }
                                  Search:='';
                             END;

                     kPgDn : BEGIN
                                  IF (Inside <> BoxLY-4) THEN
                                     Inside:=BoxLY-4
                                  ELSE BEGIN
                                       IF (TopItem+BoxLY-4 > ItemCount-(BoxLY-4)) THEN
                                          TopItem:=ItemCount-(BoxLY-4)
                                       ELSE
                                           TopItem:=TopItem+(BoxLY-4);
                                  END;

                                  Search:='';
                             END;

                     kPgUp : BEGIN
                                  IF (Inside <> 1) THEN
                                     Inside:=1
                                  ELSE BEGIN
                                       IF (TopItem < (BoxLY-4)) THEN
                                          TopItem:=0
                                       ELSE
                                           TopItem:=TopItem-(BoxLY-4);
                                  END;

                                  Search:='';
                             END;

                     kF5 : BEGIN
                                WITH CursorItemRecordPtr^ DO
                                     IF (Nummer < 65000) THEN
                                     BEGIN
                                          IF IsTagged THEN Dec (TagCount);
                                          IsTagged:=NOT IsTagged;
                                          IF IsTagged THEN Inc (TagCount);

                                          PrevInside:=0;
                                          PrintTagCount;
                                     END;

                                {
                                IF (PrevKey = kUp) THEN
                                   ForceKey:=kUp
                                ELSE }
                                    ForceKey:=kDown;

                                Search:='';
                           END;

                     kF6 : BEGIN
                                DoMultipleTag (TRUE);
                                PrevInside:=0;
                                Search:='';
                           END;

                     kF7 : BEGIN
                                DoMultipleTag (FALSE);
                                PrevInside:=0;
                                Search:='';
                           END;

                     kF2,kF3,kF4,
                     kF8,kF9,kF10,
                     kDel,
                     kRet : IF (CursorItemRecordPtr^.Nummer < 65000) THEN
                               Quit:=TRUE;

                     kIns,
                     kEsc : Quit:=TRUE;

                     kBs : BEGIN
                                IF (Search <> '') THEN
                                   Delete (Search,Length (Search),1);

                                ReSearch:=(Search <> '');
                           END;

                     kF1 : IF (HelpHandle <> 0) THEN
                              RequestHelp (HelpHandle);

                     ELSE
                         IF (AsciiKey IN [' '..'~']) THEN
                         BEGIN
                              Search:=Search+UpCase (AsciiKey);
                              ReSearch:=TRUE;
                         END;
                END; { case }

                PrevKey:=Key;
          UNTIL Quit;

          SelectSetInactive;
          SelectCursorY:=BoxY+Inside+2;
     END; { with }

     PopKeysLine;

     IF (Key IN [kRet,kDel,kF2,kF3,kF4]) THEN
        SelectSelect:=CursorItemRecordPtr^.Nummer
     ELSE
         SelectSelect:=65535;
END;
