Turbo Toolbox/Turbo_Toolbox.iso/dtx9302/tvision/tvpas/xdialogs.pas

Pascal/Delphi Source File | 1992-11-10 | 26.7 KB | 1,099 lines

(* ------------------------------------------------------ *)
(*                     XDIALOGS.PAS                       *)
(*                                                        *)
(*          Spezielle Dialog- und View-Objekte            *)
(*        (C) 1992 by Christian Ohr & DMV-Verlag          *)
(* ------------------------------------------------------ *)
{$R-,S-,I-,B-,D-,L-,V-,A+,F+,O+,X+}

UNIT XDialogs;


INTERFACE


USES Objects, Views, Drivers, Dialogs, App, XViews;


CONST
  cmProgress   = 120;
  cmWindowList = 121;

  OutOfRange = MaxInt XOR -1;

TYPE

  (* tBarView stellt einen Balken auf dem Bildschirm dar  *)
  (* dessen Länge vom Wert in Percentage abhängig ist.    *)
  (* Dieser Wert wird über eine Nachricht, deren InfoPtr  *)
  (* auf eine REAL-Variable zeigt, übermittelt. Gültige   *)
  (* Werte: 0 <= x <= 100.                                *)

  pBarView = ^tBarView;
  tBarView = OBJECT(tView)
    Percentage: REAL;
    toDoChar, DoneChar: CHAR;
    CloseOwner: BOOLEAN;
    CONSTRUCTOR Init (VAR Bounds: tRect);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE Draw; VIRTUAL;
    FUNCTION GetPalette: pPalette; VIRTUAL;
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
  END;


  (* tMonolog ist e. Dialog,d. nur per Dispose(..., Done) *)
  (* wieder verschwinden kann. Er eignet sich z.B. für    *)
  (* kurze Mitteilungen für den Anwender, auch in Verbin- *)
  (* dung mit tBarView. Routinen zum Setzen und           *)
  (* Verschwindenlassen eines einzelnen Monologs mit TEXT *)
  (* finden sich weiter unten.                            *)

  pMonolog = ^tMonolog;
  tMonolog = OBJECT(tDialog)
    CONSTRUCTOR Init(VAR Bounds: tRect; ATitle: tTitleStr);
  END;


  (* tXLabel nimmt darauf Rücksicht, ob das ihm           *)
  (* verbundene Dialogobjekt überhaupt selektierbar ist.  *)

  pXLabel = ^tXLabel;
  tXLabel = OBJECT(tLabel)
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
  END;


  (* pScrollInputLine kopiert in etwa die Eigenschaften   *)
  (* des tScroller-Objekts auf eine Eingabezeile. Dieses  *)
  (* Objekt ist noch nicht funktionsfähig und muß erst    *)
  (* noch weiterentwickelt werden (z.B. für Arrays, Kol-  *)
  (* lektionen, Queues, etc.                              *)

  pScrollInputLine = ^tScrollInputLine;
  tScrollInputLine = OBJECT(tInputLine)
    ScrollBar: pScrollBar;
    Value: INTEGER;
    Limit: tPoint;
    CONSTRUCTOR Init (VAR Bounds: tRect; AMaxLen: INTEGER;
                      AScrollBar: pScrollBar);
    CONSTRUCTOR Load (VAR S: tStream);
    FUNCTION  At (AValue: INTEGER): pString; VIRTUAL;
    PROCEDURE HandleEvent(VAR Event: tEvent); VIRTUAL;
    FUNCTION  IndexOf (P: pString): INTEGER; VIRTUAL;
    PROCEDURE ScrollDraw; VIRTUAL;
    PROCEDURE ScrollTo (AValue: INTEGER);
    PROCEDURE SetLimit (X, Y: INTEGER);
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
    FUNCTION Valid (Command: WORD): BOOLEAN; VIRTUAL;
  END;


  (* tColInputLine wendet tScrollInputLine auf Kollektio- *)
  (* nen an. Lediglich At, IndexOf und evt. SetData/Get-  *)
  (* Data/DataSize muß noch überschrieben werden, um das  *)
  (* Objekt an die Art der Kollektion anzupassen.         *)

  pColInputLine = ^tColInputLine;
  tColInputLine = OBJECT(tScrollInputLine)
    Col: pCollection;
    CONSTRUCTOR Init(VAR Bounds: TRect; AMaxLen: INTEGER;
                 AScrollBar: pScrollBar; ACol: pCollection);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
  END;


  (* Für eine StringCollection sind die Änderungen nur    *)
  (* minimal.                                             *)

  pSColInputLine = ^tSColInputLine;
  tSColInputLine = OBJECT(tColInputLine)
    FUNCTION At(AValue: INTEGER): pString; VIRTUAL;
    FUNCTION IndexOf (P: pString): INTEGER; VIRTUAL;
  END;


  (* Die ListBox, in der die auszuwählenden Daten stehen, *)
  (* welche für die betreffende Eingabezeile gültig sind. *)

  pDropViewer = ^tDropViewer;
  tDropViewer = OBJECT(tListBox)
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    FUNCTION GetPalette: pPalette; VIRTUAL;
  END;


  (* tDropWindow beherbergt den ListViewer, in dem die    *)
  (* verfügbaren Daten angezeigt werden.                  *)

  pDropWindow = ^tDropWindow;
  tDropWindow = OBJECT(tWindow)
    Viewer: pListViewer;
    CONSTRUCTOR Init (VAR Bounds: tRect;
                      AList: pCollection);
    FUNCTION GetPalette: pPalette; VIRTUAL;
    FUNCTION GetSelection: STRING; VIRTUAL;
    PROCEDURE InitViewer (AList: pCollection); VIRTUAL;
  END;


  (* tDrop ist eine Schaltfläche für Auswahlfenster in    *)
  (* Verbindung mit Eingabezeilen.                        *)

  pDrop = ^tDrop;
  tDrop = OBJECT(tView)
    DropList: pCollection;
    Link: pInputLine;
    WinHeight: INTEGER;
    CONSTRUCTOR Init (VAR Bounds: tRect; ALink: pInputLine;
                      AHeight: INTEGER; AList: pCollection);
    CONSTRUCTOR Load (VAR S: tStream);
    PROCEDURE Draw; VIRTUAL;
    FUNCTION GetPalette: pPalette; VIRTUAL;
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    PROCEDURE InitList (AList: pCollection); VIRTUAL;
    FUNCTION InitDropWindow: pDropWindow; VIRTUAL;
    PROCEDURE Store (VAR S: tStream); VIRTUAL;
  END;


  (* tWindowListBox sucht alle in den Desktop eingefügte  *)
  (* Fenster und stellt deren Namen in einer Listbox dar  *)

  pWindowListBox = ^tWindowListBox;
  tWindowListBox = OBJECT(tListBox)
    CONSTRUCTOR Init (VAR Bounds: tRect;
                      AScrollBar: pScrollBar);
    DESTRUCTOR Done; VIRTUAL;
    PROCEDURE CollectWindows;
    FUNCTION GetText (Item: INTEGER; MaxLen: INTEGER)
             : STRING; VIRTUAL;
    PROCEDURE GetData (VAR Rec); VIRTUAL;
    PROCEDURE HandleEvent (VAR Event: tEvent); VIRTUAL;
    PROCEDURE SetData (VAR Rec); VIRTUAL;
  END;


  (* Wie tInputLine, jedoch ungültig, falls leer          *)

  pKeyInputLine = ^tKeyInputLine;
  tKeyInputLine = OBJECT(tInputLine)
    FUNCTION Valid(Command: WORD): BOOLEAN; VIRTUAL;
  END;


  (* Nur Longints zwischen Min und Max sind gültig        *)

  pNumInputLine = ^tNumInputLine;
  tNumInputLine = OBJECT(tInputLine)
    Min: LONGINT;
    Max: LONGINT;
    CONSTRUCTOR Init(VAR Bounds: tRect; AMaxLen: INTEGER;
                     AMin, AMax: LONGINT);
    CONSTRUCTOR Load(VAR S: tStream);
    FUNCTION DataSize: WORD; VIRTUAL;
    PROCEDURE GetData(VAR Rec); VIRTUAL;
    PROCEDURE SetData(VAR Rec); VIRTUAL;
    PROCEDURE Store(VAR S: tStream);
    FUNCTION Valid(Command: WORD): BOOLEAN; VIRTUAL;
  END;


CONST
  rScrollInputLine: tStreamRec = (
    ObjType: 1200;
    VmtLink: Ofs(TypeOf(tScrollInputLine)^);
    Load:    @tScrollInputLine.Load;
    Store:   @tScrollInputLine.Store
  );
  rColInputLine: tStreamRec = (
    ObjType: 1201;
    VmtLink: Ofs(TypeOf(tColInputLine)^);
    Load:    @tColInputLine.Load;
    Store:   @tColInputLine.Store
  );
  rSColInputLine: tStreamRec = (
    ObjType: 1202;
    VmtLink: Ofs(TypeOf(tSColInputLine)^);
    Load:    @tSColInputLine.Load;
    Store:   @tSColInputLine.Store
  );
  rBarView : tStreamRec = (
    ObjType: 1203;
    VmtLink: Ofs(TypeOf(tBarView)^);
    Load:    @tBarView.Load;
    Store:   @tBarView.Store
  );
  rMonolog : tStreamRec = (
    ObjType: 1204;
    VmtLink: Ofs(TypeOf(tMonolog)^);
    Load:    @tMonolog.Load;
    Store:   @tMonolog.Store
  );
  rXLabel : tStreamRec = (
    ObjType: 1205;
    VmtLink: Ofs(TypeOf(tXLabel)^);
    Load:    @tXLabel.Load;
    Store:   @tXLabel.Store
  );
  rWindowListBox : tStreamRec = (
    ObjType: 1206;
    VmtLink: Ofs(TypeOf(tWindowListBox)^);
    Load:    @tWindowListBox.Load;
    Store:   @tWindowListBox.Store
  );
  rDrop : tStreamRec = (
    ObjType: 1207;
    VmtLink: Ofs(TypeOf(tDrop)^);
    Load:    @tDrop.Load;
    Store:   @tDrop.Store
  );
  rKeyInputLine: tStreamRec = (
     ObjType: 1208;
     VmtLink: Ofs(TypeOf(tKeyInputLine)^);
     Load:    @tKeyInputLine.Load;
     Store:   @tKeyInputLine.Store
  );
  rNumInputLine: tStreamRec = (
     ObjType: 1209;
     VmtLink: Ofs(TypeOf(tNumInputLine)^);
     Load:    @tNumInputLine.Load;
     Store:   @tNumInputLine.Store
  );



(* Routinen z. Auf- und Abhängen eines tMonolog mit einer *)
(* kurzen Mitteilung. Es kann nur ein Monolog auf einmal  *)
(* hängen.                                                *)

PROCEDURE PinUp (W, H: INTEGER; S: STRING; Params: POINTER);
PROCEDURE PinDown;


(* Routine für einen Dialog mit Fensterliste              *)

PROCEDURE WindowListDialog;


FUNCTION ExecDialog(P: pDialog; Data: POINTER): WORD;

PROCEDURE RegisterXDialogs;


IMPLEMENTATION


USES MsgBoxG;


CONST
  Pinned: BOOLEAN = FALSE;

VAR
  P: pMonolog;


FUNCTION SSet(C : CHAR; Len : BYTE) : STRING; ASSEMBLER;
ASM
  LES DI, @Result
  CLD
  XOR CH, CH
  MOV CL, Len       (* STRING-Länge in CX   *)
  MOV AX, CX        (* und in AX            *)
  STOSB             (* Längenbyte speichern *)
  MOV AL, C
  REP STOSB         (* STRING auffüllen     *)
END;



(* -------------------------------------------------------*)
(*                      tBarView                          *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tBarView.Init (VAR Bounds: tRect);
BEGIN
  tView.Init(Bounds);
  toDoChar := #177;
  DoneChar := #219;
  Percentage := 0.0;
  Options := Options AND NOT ofSelectable;
  EventMask := evBroadcast;
END;


CONSTRUCTOR tBarView.Load (VAR S: tStream);
BEGIN
  tView.Load(S);
  S.Read(Percentage, SizeOf(REAL));
  S.Read(toDoChar, SizeOf(CHAR));
  S.Read(DoneChar, SizeOf(CHAR));
END;


PROCEDURE tBarView.Draw;
VAR
  B: tDrawBuffer;
  IntPerc, BarLen: INTEGER;
  PercStr: STRING[5];
BEGIN
  IntPerc := Round(Percentage * 100);
  BarLen := Size.X - 5;
  IF NOT (IntPerc > 100) THEN BEGIN
    WriteStr(0, 0, SSet(DoneChar,
      Round(BarLen * Percentage)) + SSet(
       toDoChar, BarLen - Round(BarLen * Percentage)), 2);
    Str(IntPerc:4, PercStr); PercStr := PercStr + '%';
    WriteStr(BarLen, 0, PercStr, 1);
  END;
END;


FUNCTION tBarView.GetPalette: pPalette;
CONST
  cBarView: STRING[Length(cLabel)] = cLabel;
BEGIN
  GetPalette := @cBarView;
END;


PROCEDURE tBarView.HandleEvent (VAR Event: tEvent);
BEGIN
  tView.HandleEvent(Event);
  IF Event.What = evBroadcast THEN
    IF Event.Command = cmProgress THEN BEGIN
      Percentage := REAL(Event.InfoPtr^);
      DrawView;
      ClearEvent(Event);
    END;
END;


PROCEDURE tBarView.Store (VAR S: tStream);
BEGIN
  tView.Store(S);
  S.Write(Percentage, SizeOf(REAL));
  S.Write(toDoChar, SizeOf(CHAR));
  S.Write(DoneChar, SizeOf(CHAR));
END;



(* ------------------------------------------------------ *)
(*                      tMonolog                          *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tMonolog.Init (VAR Bounds: tRect;
                           ATitle: tTitleStr);
BEGIN
  tDialog.Init(Bounds, ATitle);
  Flags := Flags AND NOT wfClose;
END;



(* ------------------------------------------------------ *)
(*                       tXLabel                          *)
(* ------------------------------------------------------ *)


PROCEDURE tXLabel.HandleEvent (VAR Event: tEvent);
BEGIN
  IF (Link <> NIL) AND
     (Link^.Options AND ofSelectable = 0) THEN Exit;
  tLabel.HandleEvent(Event);
END;


(* ------------------------------------------------------ *)
(*                  tScrollInputLine                      *)
(* ------------------------------------------------------ *)



CONSTRUCTOR tScrollInputLine.Init (VAR Bounds: tRect;
             AMaxLen: INTEGER; AScrollBar: pScrollBar);
BEGIN
  tInputLine.Init(Bounds, AMaxLen);
  ScrollBar := AScrollBar;
  EventMask := EventMask OR evBroadcast;
END;


CONSTRUCTOR tScrollInputLine.Load (VAR S: tStream);
BEGIN
  tInputLine.Load(S);
  GetPeerViewPtr(S, ScrollBar);
  S.Write(Value, SizeOf(INTEGER));
  S.Write(Limit.X, SizeOf(INTEGER));
  S.Write(Limit.Y, SizeOf(INTEGER));
END;


FUNCTION tScrollInputLine.At (AValue: INTEGER): pString;
BEGIN
  Abstract;
END;


PROCEDURE tScrollInputLine.HandleEvent(VAR Event: tEvent);
VAR
  KeyIn: BOOLEAN;
BEGIN
  KeyIn := Event.What = evKeyDown;
  tInputLine.HandleEvent(Event);

  CASE Event.What OF
    evKeyDown:
      BEGIN
        CASE Event.KeyCode OF
          kbUp:
            IF Value >= Limit.X + ScrollBar^.ArStep THEN
              ScrollTo(Value - ScrollBar^.ArStep) ELSE
              ScrollTo(Limit.X);
          kbDown:
            IF Value <= Limit.Y - ScrollBar^.ArStep THEN
              ScrollTo(Value + ScrollBar^.ArStep) ELSE
              ScrollTo(Limit.Y);
          kbPgUp:
            IF Value >= Limit.X + ScrollBar^.PgStep THEN
              ScrollTo(Value - ScrollBar^.PgStep) ELSE
              ScrollTo(Limit.X);
          kbPgDn:
            IF Value <= Limit.Y - ScrollBar^.PgStep THEN
              ScrollTo(Value + ScrollBar^.PgStep) ELSE
              ScrollTo(Limit.Y);
          ELSE Exit;
        END;
        ClearEvent(Event);
        Exit;
      END;
    evBroadcast:
      CASE Event.Command OF
        cmScrollBarChanged:
          IF Event.InfoPtr = ScrollBar THEN
            ScrollDraw;
        cmScrollBarClicked:
          ;
    END;
  END;
  IF KeyIn THEN
    IF IndexOf(Data) <> OutOfRange THEN
      ScrollTo(IndexOf(Data));
END;


FUNCTION tScrollInputLine.IndexOf(P: pString): INTEGER;
BEGIN
  Abstract;
END;


PROCEDURE tScrollInputLine.ScrollDraw;
BEGIN
  IF Value <> ScrollBar^.Value THEN
    Value := ScrollBar^.Value;
  Data^ := At(Value)^;
  SelectAll(TRUE);
END;


PROCEDURE tScrollInputLine.ScrollTo (AValue: INTEGER);
BEGIN
  Value := AValue;
  ScrollBar^.SetValue(Value);
END;


PROCEDURE tScrollInputLine.SetLimit (X, Y: INTEGER);
BEGIN
  Limit.X := X;
  Limit.Y := Y;
  ScrollBar^.SetRange(X, Y);
END;


PROCEDURE tScrollInputLine.Store (VAR S: tStream);
BEGIN
  tInputLine.Store(S);
  PutPeerViewPtr(S, ScrollBar);
  S.Read(Value, SizeOf(INTEGER));
  S.Read(Limit.X, SizeOf(INTEGER));
  S.Read(Limit.Y, SizeOf(INTEGER));
END;


FUNCTION tScrollInputLine.Valid (Command: WORD): BOOLEAN;
VAR
  Ok: BOOLEAN;
BEGIN
  Ok := TRUE;
  IF (Command <> cmCancel) AND (Command <> cmValid) THEN
    IF (Value < Limit.X) OR (Value > Limit.Y) OR
       (IndexOf(Data) = OutOfRange) THEN BEGIN
      Select;
      MessageBox('Ungültige Eingabe.', NIL,
                 mfError + mfOkButton);
      SelectAll(TRUE);
      Ok := FALSE;
  END;
  IF Ok THEN
    Valid := tInputLine.Valid(Command) ELSE
    Valid := FALSE;
END;



(* ------------------------------------------------------ *)
(*                    tColInputLine                       *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tColInputLine.Init(VAR Bounds: TRect;
                   AMaxLen: INTEGER; AScrollBar: pScrollBar;
                   ACol: pCollection);
BEGIN
  tScrollInputLine.Init(Bounds, AMaxLen, AScrollBar);
  Col := ACol;
  IF Col <> NIL THEN BEGIN
    SetLimit(0, Pred(Col^.Count));
    IF ScrollBar <> NIL THEN
      IF ScrollBar^.Size.Y = 1 THEN
        ScrollBar^.SetStep(Col^.Count DIV
                           ScrollBar^.Size.X, 1) ELSE
        ScrollBar^.SetStep(Col^.Count DIV
                           ScrollBar^.Size.Y, 1);
  END;
END;


CONSTRUCTOR tColInputLine.Load (VAR S: tStream);
BEGIN
  tScrollInputLine.Load(S);
  S.Put(Col);
END;


PROCEDURE tColInputLine.Store (VAR S: tStream);
BEGIN
  tScrollInputLine.Store(S);
  Col := pCollection(S.Get);
END;



(* ------------------------------------------------------ *)
(*                    tSColInputLine                      *)
(* ------------------------------------------------------ *)


FUNCTION tSColInputLine.At (AValue: INTEGER): pString;
BEGIN
  IF (AValue >= Limit.X) AND (AValue <= Limit.Y) THEN
    At := pString(Col^.At(AValue));
END;


FUNCTION tSColInputLine.IndexOf (P: pString): INTEGER;
VAR
  Index: INTEGER;
BEGIN
  Index := Col^.IndexOf(P);
  IF Index = -1 THEN
    IndexOf := OutOfRange ELSE
    IndexOf := Index;
END;



(* ------------------------------------------------------ *)
(*                     tDropViewer                        *)
(* ------------------------------------------------------ *)


PROCEDURE tDropViewer.HandleEvent (VAR Event: tEvent);
BEGIN
  IF ((Event.What = evCommand) AND
      (Event.Command = cmClose)) OR
     ((Event.What = evKeyDown) AND
      (Event.KeyCode = kbEsc)) THEN BEGIN
    EndModal(cmCancel);
    ClearEvent(Event);
  END ELSE
  IF ((Event.What = evKeyDown) AND
      (Event.KeyCode = kbEnter)) OR
     ((Event.What = evMouseDown) AND
       Event.DOUBLE) THEN BEGIN
    IF List^.Count > 0 THEN
      EndModal(cmOk) ELSE
      EndModal(cmCancel);
    ClearEvent(Event);
  END;
  tListBox.HandleEvent(Event);
END;


FUNCTION tDropViewer.GetPalette: pPalette;
CONST
  cDropViewer : STRING[Length(cHistoryViewer)]
              = cHistoryViewer;
BEGIN
  GetPalette := @cDropViewer;
END;



(* ------------------------------------------------------ *)
(*                     tDropWindow                        *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tDropWindow.Init (VAR Bounds: tRect;
                              AList: pCollection);
BEGIN
  tWindow.Init(Bounds, '', wnNoNumber);
  Flags := wfClose;
  InitViewer(AList);
END;


FUNCTION tDropWindow.GetSelection: STRING;
BEGIN
  GetSelection := Viewer^.GetText(Viewer^.Focused, 255);
END;


FUNCTION tDropWindow.GetPalette: pPalette;
CONST
  cDropWindow : STRING[Length(cHistoryWindow)]
              = cHistoryWindow;
BEGIN
  GetPalette := @cDropWindow;
END;


PROCEDURE tDropWindow.InitViewer (AList: pCollection);
VAR
  R: tRect;
  ScrollBar: pScrollBar;
BEGIN
  GetExtent(R);
  R.Grow(-1, -1);
  Viewer := New(pDropViewer, Init(R, 1, StandardScrollBar(
                sbVertical + sbHandleKeyboard)));
  pListBox(Viewer)^.NewList(AList);
  Insert(Viewer);
END;



(* ------------------------------------------------------ *)
(*                        tDrop                           *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tDrop.Init (VAR Bounds:tRect; ALink: pInputLine;
                      AHeight: INTEGER; AList: pCollection);
BEGIN
  tView.Init(Bounds);
  Options := Options OR ofPostProcess;
  EventMask := EventMask OR evBroadcast;
  Link := ALink;
  WinHeight := AHeight;
  InitList(AList);
END;


CONSTRUCTOR tDrop.Load (VAR S: tStream);
BEGIN
  tView.Load(S);
  GetPeerViewPtr(S, Link);
  S.Read(WinHeight, SizeOf(INTEGER));
  DropList := pCollection(S.Get);
END;


PROCEDURE tDrop.Draw;
VAR
  T: tDrawBuffer;
BEGIN
  MoveCStr(T, '▐~~▌', GetColor($0102));
  WriteLine(0, 0, 3, 1, T);
END;


FUNCTION tDrop.GetPalette: pPalette;
CONST
  cDrop : STRING[Length(cHistory)] = cHistory;
BEGIN
  GetPalette := @cDrop;
END;


PROCEDURE tDrop.HandleEvent (VAR Event: tEvent);

  PROCEDURE Drop;
  VAR
    DropWindow: pDropWindow;
    Data: STRING;
  BEGIN
    DropWindow := InitDropWindow;
    IF Owner^.ExecView(DropWindow) = cmOk THEN BEGIN
      Data := DropWindow^.GetSelection;
      Link^.SetData(Data);
      Link^.SelectAll(TRUE);
    END;
    Dispose(DropWindow, Done);
  END;

BEGIN
  IF ((Event.What = evMouseDown) AND
      MouseInView(Event.Where)) OR
     ((Event.What = evKeyDown) AND
      (Event.KeyCode = kbDown)) THEN BEGIN
    Drop;
    ClearEvent(Event);
  END;
  tView.HandleEvent(Event);
END;


FUNCTION tDrop.InitDropWindow: pDropWindow;
VAR
  R: tRect;
BEGIN
  Link^.GetBounds(R);
  Inc(R.A.Y);
  R.B.Y := R.A.Y + WinHeight;
  InitDropWindow := New(pDropWindow, Init(R, DropList));
END;


PROCEDURE tDrop.InitList (AList: pCollection);
BEGIN
  DropList := AList;
END;


PROCEDURE tDrop.Store (VAR S: tStream);
BEGIN
  tView.Store(S);
  PutPeerViewPtr(S, Link);
  S.Write(WinHeight, SizeOf(INTEGER));
  S.Put(DropList);
END;



(* ------------------------------------------------------ *)
(*                    tWindowListBox                      *)
(* ------------------------------------------------------ *)


CONSTRUCTOR tWindowListBox.Init (VAR Bounds: tRect;
                                 AScrollBar: pScrollBar);
VAR
  R: tRect;
BEGIN
  tListBox.Init(Bounds, 1, AScrollBar);
  CollectWindows;
END;


DESTRUCTOR tWindowListBox.Done;
BEGIN
  IF List <> NIL THEN BEGIN
    List^.DeleteAll;
    Dispose(List, Done);
  END;
  tListBox.Done;
END;


PROCEDURE tWindowListBox.CollectWindows;
VAR
  AList: pCollection;

  PROCEDURE GetWindows (P: pIDWindow); FAR;
  VAR
    M: POINTER;
  BEGIN
    M := Message(P, evBroadcast, cmWhoisWindow, NIL);
    IF M <> NIL THEN
      AList^.Insert(pWindow(P));
  END;

BEGIN
  AList := New(pCollection, Init(5, 2));
  Desktop^.ForEach(@GetWindows);
  NewList(AList);
  IF List^.Count = 0 THEN
    State := State OR sfDisabled;
END;


FUNCTION tWindowListBox.GetText (Item: INTEGER; MaxLen:
                                 INTEGER): STRING;
BEGIN
  IF pWindow(List^.At(Item))^.GetTitle(MaxLen) = '' THEN
    GetText := 'Unbenannt' ELSE
    GetText := pIDWindow(List^.At(Item))^.GetTitle(MaxLen);
END;


PROCEDURE tWindowListBox.GetData(VAR Rec);
BEGIN
  IF List^.Count <> 0 THEN
    pIDWindow(Rec) := pIDWindow(List^.At(Focused)) ELSE
    pIDWindow(Rec) := NIL;
END;


PROCEDURE tWindowListBox.HandleEvent (VAR Event: tEvent);
BEGIN
  IF (Event.What = evMouseDown) AND (Event.DOUBLE) THEN
  BEGIN
    Event.What := evCommand;
    Event.Command := cmOK;
    PutEvent(Event);
    ClearEvent(Event);
  END ELSE
    tListBox.HandleEvent(Event);
END;


PROCEDURE tWindowListBox.SetData(VAR Rec);
BEGIN
END;



(* ------------------------------------------------------ *)
(*                    tKeyInputLine                       *)
(* ------------------------------------------------------ *)


FUNCTION tKeyInputLine.Valid(Command: WORD): BOOLEAN;
VAR
  Ok: BOOLEAN;
BEGIN
  Ok := TRUE;
  IF (Command <> cmCancel) AND
     (Command <> cmValid) THEN BEGIN
    IF Data^ = '' THEN BEGIN
      Select;
      MessageBox('Dieses Feld muß Daten enthalten.', NIL,
                  mfError + mfOkButton);
      Ok := FALSE;
    END;
  END;
  IF Ok THEN
    Valid := tInputLine.Valid(Command) ELSE
    Valid := FALSE;
END;



(* ------------------------------------------------------ *)
(*                    tNumInputLine                       *)
(* ------------------------------------------------------ *)


CONSTRUCTOR TNumInputLine.Init(VAR Bounds: tRect;
            AMaxLen: INTEGER; AMin, AMax: LONGINT);
BEGIN
  tInputLine.Init(Bounds, AMaxLen);
  Min := AMin;
  Max := AMax;
END;


CONSTRUCTOR tNumInputLine.Load(VAR S: tStream);
BEGIN
  tInputLine.Load(S);
  S.Read(Min, SizeOf(LONGINT) * 2);
END;


FUNCTION tNumInputLine.DataSize: WORD;
BEGIN
  DataSize := SizeOf(LONGINT);
END;


PROCEDURE tNumInputLine.GetData(VAR Rec);
VAR
  Code: INTEGER;
BEGIN
  Val(Data^, LONGINT(Rec), Code);
END;


PROCEDURE tNumInputLine.Store(VAR S: tStream);
BEGIN
  tInputLine.Store(S);
  S.Write(Min, SizeOf(LONGINT) * 2);
END;


PROCEDURE tNumInputLine.SetData(VAR Rec);
VAR
  S: STRING[12];
BEGIN
  Str(LONGINT(Rec), Data^);
  SelectAll(TRUE);
END;


FUNCTION tNumInputLine.Valid(Command: WORD): BOOLEAN;
VAR
  Code: INTEGER;
  Value: LONGINT;
  Params: ARRAY[0..1] OF LONGINT;
  Ok: BOOLEAN;
BEGIN
  Ok := TRUE;
  IF (Command <> cmCancel) AND
     (Command <> cmValid) THEN BEGIN
    IF Data^ = '' THEN Data^ := '0';
    Val(Data^, Value, Code);
    IF (Code <> 0) OR (Value < Min) OR
       (Value > Max) THEN BEGIN
      Select;
      Params[0] := Min;
      Params[1] := Max;
      MessageBox('Gültiger Zahlenbereich: %D TO %D.',
                  @Params, mfError + mfOkButton);
      SelectAll(TRUE);
      Ok := FALSE;
    END;
  END;
  IF Ok THEN
    Valid := tInputLine.Valid(Command) ELSE
    Valid := FALSE;
END;




PROCEDURE WindowListDialog;
VAR
  Result: WORD;
  Selected: pIDWindow;
  D: pDialog;
  R: tRect;
  C: pView;
BEGIN
  R.Assign(0, 0, 51, 15);
  D := New(pDialog, Init(R, 'Fenster'));

  WITH D^ DO BEGIN
    Options := Options OR ofCentered;

    R.Assign( 36, 3, 37, 13);
    C := New(pScrollBar, Init(R));
    Insert(C);

    R.Assign( 3, 3, 36, 13);
    C := New(pWindowListBox, Init(R, pScrollBar(C)));
    Insert(C);
    R.Assign( 2, 2, 12, 3);
    Insert(New(pLabel, Init(R, 'Fenster', C)));
    R.Assign(38, 3, 48, 5);
    Insert(New(pButton, Init(R, 'O~k~', cmOk,
                             bfDefault)));
    R.Move(0, 3); Inc(R.B.X);
    Insert(New(pButton, Init(R, '~L~öschen', cmNo,
                             bfNormal)));
    R.Move(0, 3);
    Insert(New(pButton, Init(R, 'Abbruch', cmCancel,
                             bfNormal)));
    SelectNext(FALSE);
  END;

  Result := ExecDialog(D, @Selected);

  CASE Result OF
    cmOk:
      IF Selected <> NIL THEN BEGIN
        Selected^.MakeFirst;
        Selected^.Show;
      END;
    cmNo:
      IF Selected <> NIL THEN Selected^.Close;
  END;
END;


PROCEDURE PinUp (W, H: INTEGER; S: STRING; Params: POINTER);
VAR
  R: tRect;
  PS: STRING;
BEGIN
  IF Pinned THEN Exit;
  R.Assign(0, 0, W, H);
  P := New(pMonolog, Init(R, ''));
  WITH P^ DO BEGIN
    Options := Options OR ofCentered;
    GetExtent(R);
    R.Grow(-1, -1);
    FormatStr(PS, S, Params^);
    Insert(New(pStaticText, Init(R, PS)));
  END;
  Desktop^.Insert(P);
  Pinned := TRUE;
END;


PROCEDURE PinDown;
BEGIN
  IF NOT Pinned THEN Exit;
  Dispose(P, Done);
  Pinned := FALSE;
END;


FUNCTION ExecDialog(P: pDialog; Data: POINTER): WORD;
VAR
  Result: WORD;
BEGIN
  Result := cmCancel;
  P := pDialog(Application^.ValidView(P));
  IF P <> NIL THEN
  BEGIN
    IF Data <> NIL THEN P^.SetData(Data^);
    Result := DeskTop^.ExecView(P);
    IF (Result <> cmCancel) AND (Data <> NIL) THEN
      P^.GetData(Data^);
    Dispose(P, Done);
  END;
  ExecDialog := Result;
END;



PROCEDURE RegisterXDialogs;
BEGIN
  RegisterType(rBarView);
  RegisterType(rMonolog);
  RegisterType(rScrollInputLine);
  RegisterType(rColInputLine);
  RegisterType(rSColInputLine);
  RegisterType(rWindowListBox);
  RegisterType(rDrop);
  RegisterType(rKeyInputLine);
  RegisterType(rNumInputLine);
END;


END.


(* ------------------------------------------------------ *)
(*                 Ende von XDIALOGS.PAS                  *)