home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / uldialog / uldial.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-12  |  19.5 KB  |  649 lines
  1. (***********************************************************************
  2.      Dialog Objects as Enhancements to Turbo Power OOP Professional
  3.                   New Communications Technology, Inc.
  4.                              Version 2.00
  5.                           by John Poindexter
  6.                              July 8, 1990
  7. ************************************************************************)
  8. {$I ULDEFINE.INC}
  9.  
  10. {$IFNDEF dlDEBUG}
  11. {$A-,B-,E+,F+,I+,N-,O+,R-,S-,V-}
  12. {$ELSE}
  13. {$A-,B-,E+,F+,I+,N-,O+,R+,S+,V-}
  14. {$ENDIF}
  15.  
  16. Unit ULDial;
  17.  
  18. Interface
  19.  
  20. Uses OpRoot, OpDos, OpCrt, OpMouse, OpInline, OpString, OpCmd,
  21.      OpFrame, OpWindow, OpPick, OpField, OpEntry, OpKey,
  22.      ULRoot;
  23.  
  24. const
  25.  
  26. (* Status Handler Return Codes *)
  27.   scOk      = 1;
  28.   scCancel  = 2;
  29.   scRetry   = 3;
  30.   scTimeOut = 99;
  31.  
  32. type
  33.  
  34.   HorizVerticalType = (rbHoriz, rbVertical);
  35.  
  36. var
  37.   ButtonFrame : FrameArray;
  38.  
  39. type
  40.  
  41. (************************************************************************
  42.   RadioButtons is a descendant of PickList
  43. ************************************************************************)
  44.  
  45.   RadioButtonsPtr = ^RadioButtons;
  46.   RadioButtons = object(PickList)
  47.     rbChoices : MStringArrayPtr;
  48.     rbOrient : HorizVerticalType;
  49.     constructor Init(X1,Y1,X2,Y2: byte; var Colors: ColorSet;
  50.                     Options: longint; Orientation: HorizVerticalType;
  51.                     NrRows, NrCols: byte; CharExit: boolean;
  52.                     CommandHandler: pkGenlProc;
  53.                     PickOptions: word; Choices: MStringArrayPtr);
  54.     destructor Done; virtual;
  55.     procedure ItemString(Item: word; Mode: pkMode; var IType: pkItemType;
  56.                          var IString: string); virtual;
  57.     procedure ProcessSelf; virtual;
  58.   end;
  59.  
  60. (************************************************************************
  61.   DialogBox displays text, a string entry field and provides radio
  62.   buttons for exiting.
  63. ************************************************************************)
  64.  
  65.   DialogBoxPtr = ^DialogBox;
  66.   DialogBox = object(Root)
  67.     dlX1,dlY1,dlX2,dlY2 : word;   {Coordinates of Entry Screen}
  68.     dlButOrient : HorizVerticalType;
  69.     dlNrRows : byte;
  70.     dlNrCols : byte;
  71.     dlCharExit : boolean;
  72.     dlHeader : string[78];
  73.     dlHeaderPos : HeaderPosType;
  74.     dlText : MStringArrayPtr;
  75.     dlChoices : MStringArrayPtr;
  76.     dlTNum, dlCNum : byte;
  77.     dlOptions : longint;
  78.     dlColors : ColorSet;
  79.     dlEntry : EntryScreenPtr;
  80.     dlButtons : RadioButtonsPtr;
  81.     dlPrompt : string;
  82.     dlpRow, dlpCol, dlfRow, dlfCol: word;
  83.     dlFieldRows : byte;
  84.     dlPicture : string;
  85.     dlfWidth : word;
  86.     dlHelpIndex : word;
  87.     dlEditSt: string;
  88.     dlTimeOut : longint;
  89.     dlLastChoice : word;
  90.     dlLastError: word;
  91.     dlNumTextLines : byte;
  92.     dlTotalTextChars : word;
  93.     dlNumChoices : byte;
  94.     dlTotalChoiceChars : word;
  95.     dlOrientation : pkGenlProc;
  96.     constructor Init(ButtonOrientation: HorizVerticalType;
  97.                      NumTextLines, TotalTextChars,
  98.                      NumChoices, TotalChoiceChars: word);
  99.     constructor InitDeluxe(X1, Y1: word; Options: longint; Colors: ColorSet;
  100.                            Orientation: HorizVerticalType;
  101.                            NrRows, NrCols: byte; CharExit: boolean;
  102.                            NumTextLines, TotalTextChars,
  103.                            NumChoices, TotalChoiceChars: word);
  104.     destructor Done; virtual;
  105.     procedure Clear;
  106.     function GetLastError: word;
  107.     procedure Process; virtual;
  108.     procedure AddMessageString(Msg: string);
  109.     procedure AddChoiceString(Choice: string);
  110.     procedure AddChoice(Choice: string);
  111.     procedure AddHeader(S: string; Posn: HeaderPosType);
  112.     procedure AddStringEntryField(Prompt: string; pRow, pCol: word;
  113.                                   Picture: string; fRow, fCol: word;
  114.                                   fWidth: byte; HelpIndex: word;
  115.                                   EditSt: string);
  116.     function CreateBox: boolean; virtual;
  117.     function GetLastChoice: word;
  118.     function GetEditedString: string;
  119.     procedure SetTimeOut(Delay: word);
  120.   end;
  121.  
  122. (***********************************************************************)
  123. Implementation
  124. (***********************************************************************)
  125.  
  126. (* RadioButtons Methods *)
  127.  
  128. constructor RadioButtons.Init(X1,Y1,X2,Y2: byte; var Colors: ColorSet;
  129.                 Options: longint; Orientation: HorizVerticalType;
  130.                 NrRows, NrCols: byte; CharExit: boolean;
  131.                 CommandHandler: pkGenlProc;
  132.                 PickOptions: word; Choices: MStringArrayPtr);
  133. const
  134.   SelColorFlex : FlexAttrs = (0,0,0,0);
  135.   SelMonoFlex  : FlexAttrs = (0,0,0,0);
  136.   UnsColorFlex : FlexAttrs = (0,0,0,0);
  137.   UnsMonoFlex  : FlexAttrs = (0,0,0,0);
  138. var
  139.   Orient : pkGenlProc;
  140. begin
  141.   with Colors do
  142.   if UseColor then
  143.   begin
  144.     UnsColorFlex[0] := TextColor;
  145.     UnsColorFlex[1] := FlexAHelpColor;
  146.     UnsColorFlex[2] := TextColor;
  147.     SelColorFlex[0] := TextColor;
  148.     SelColorFlex[1] := FlexAHelpColor;
  149.     SelColorFlex[2] := SelItemColor;
  150.     ProItemColor    := TextColor;
  151.   end
  152.   else
  153.   begin
  154.     UnsMonoFlex[0]  := TextMono;
  155.     UnsMonoFlex[1]  := FlexAHelpMono;
  156.     UnsMonoFlex[2]  := TextMono;
  157.     SelMonoFlex[0]  := TextMono;
  158.     SelMonoFlex[1]  := FlexAHelpMono;
  159.     SelMonoFlex[2]  := SelItemMono;
  160.     ProItemMono     := TextMono;
  161.   end;
  162.   rbOrient := Orientation;
  163.   if Orientation = rbHoriz then Orient := PickSnaking
  164.   else Orient := PickVertical;
  165.   if not PickList.InitAbstractDeluxe(X1,Y1,X2,Y2,Colors,Options,
  166.                                      Choices^.GetMaxLen+4,
  167.                                      3*Choices^.NumStrings,
  168.                                      Orient,CommandHandler,
  169.                                      PickOptions) then Fail;
  170.   if Orientation = rbHoriz then
  171.   begin
  172.     SetRowLimits(3*NrRows,3*NrRows);
  173.     PickCommands.AddCommand(ccUser0, 1, Up, 0);
  174.   end
  175.   else
  176.   begin
  177.     PickCommands.AddCommand(ccUser0, 1, Left, 0);
  178.   end;
  179.   SetPickFlex(pkNormal, True, SelColorFlex, SelMonoFlex);
  180.   SetPickFlex(pkNormal, False, UnsColorFlex, UnsMonoFlex);
  181.   if CharExit then SetSearchMode(PickCharExit)
  182.   else SetSearchMode(PickCharSearch);
  183.   rbChoices := Choices;
  184. end;
  185.  
  186. destructor RadioButtons.Done;
  187. begin
  188.   if rbOrient = rbHoriz then
  189.   PickCommands.AddCommand(ccUp, 1, Up, 0)  {restore normal commands}
  190.   else PickCommands.AddCommand(ccLeft, 1, Left, 0);
  191.   PickList.Done;
  192. end;
  193.  
  194. procedure RadioButtons.ItemString(Item: word; Mode: pkMode; var IType: pkItemType;
  195.                                var IString: string);
  196. var
  197.   Which : byte;
  198.   Choice : word;
  199. begin
  200.   Choice := Pred(Item);
  201.   Which := Choice mod 3;
  202.   if Which <> 1 then IType := pkProtected;
  203.   if Mode = pkGetType then Exit;
  204.   Case Which of
  205.     0 : IString := ButtonFrame[0]+
  206.                    CharStr(ButtonFrame[4],rbChoices^.GetMaxLen+2)+
  207.                    ButtonFrame[2];
  208.     1 : begin
  209.           IString := rbChoices^.GetString(Choice div 3 + 1);
  210.           IString := ButtonFrame[6]+' '+Pad(IString, rbChoices^.GetMaxLen)+
  211.                      ' '+ButtonFrame[7];
  212.           Case Mode of
  213.             pkDisplay :
  214.                 begin
  215.                   Insert(^B, Istring, Length(Istring));
  216.                   Insert(^B, Istring, 4);
  217.                   Insert(^A, Istring, 4);
  218.                   Insert(^A, Istring, 3);
  219.                   Insert(^B, Istring, 3);
  220.                   Insert(^B, Istring, 2);
  221.                 end;
  222.             pkSearch  : IString := Copy(IString, 3, Length(IString)-4);
  223.           end;
  224.         end;
  225.     2 : IString := ButtonFrame[1]+
  226.                    CharStr(ButtonFrame[5],rbChoices^.GetMaxLen+2)+
  227.                    ButtonFrame[3];
  228.   end;
  229. end;
  230.  
  231. procedure RadioButtons.ProcessSelf;
  232. begin
  233.   PickList.ProcessSelf;
  234.   if (GetLastCommand = ccSelect) or (GetLastcommand = ccMouseSel) then
  235.     SetLastCommand(ccDone)
  236.   else if GetLastCommand = ccUser0 then SetLastCommand(ccBackTab);
  237. end;
  238.  
  239. (* DialogBox Methods
  240.  
  241.                    dlX1
  242.                dlY1┌─────────────────────┐
  243.                    │     X1        X2    │
  244.                    │   Y1┌────┐┌────┐    │
  245.                    │     └────┘└────┘    │
  246.                    └─────────────────────┘dlY2
  247.                                       dlX2
  248. *)
  249. constructor DialogBox.Init(ButtonOrientation: HorizVerticalType;
  250.                            NumTextLines, TotalTextChars,
  251.                            NumChoices, TotalChoiceChars: word);
  252. begin
  253.   if not Root.Init then Fail;
  254.   dlX1 := 0;
  255.   dlY1 := 0;
  256.   dlPrompt := '';
  257.   dlpRow := 0;
  258.   dlpCol := 0;
  259.   dlPicture := '';
  260.   dlfRow := 0;
  261.   dlfCol := 0;
  262.   dlFieldRows := 0;
  263.   dlfWidth := 0;
  264.   dlHelpIndex := hiDialogBox;
  265.   dlEditSt := '';
  266.   dlLastError := 0;
  267.   dlTimeOut := 0;
  268.   dlLastChoice := 0;
  269.   dlHeader := '';
  270.   dlEntry := nil;
  271.   dlButtons := nil;
  272.   dlOptions := DefWindowOptions+wBordered;
  273.   dlColors := ULRootColorSet;
  274.   dlButOrient := ButtonOrientation;
  275.   dlCharExit := false;
  276.   dlNrRows := 1;
  277.   dlNrCols := 1;
  278.   dlNumTextLines := NumTextLines;
  279.   dlTotalTextChars := TotalTextChars;
  280.   dlNumChoices := NumChoices;
  281.   dlTotalChoiceChars := TotalChoiceChars;
  282.   dlText := New(MStringArrayPtr,Init(NumTextLines, TotalTextChars));
  283.   dlChoices := New(MStringArrayPtr,Init(NumChoices, TotalChoiceChars));
  284.   if (dlText = nil) or (dlChoices = nil) then
  285.   begin
  286.     if dlText <> nil then Dispose(dlText, Done);
  287.     if dlChoices <> nil then Dispose(dlChoices, Done);
  288.     Root.Done;
  289.     Fail;
  290.   end;
  291. end;
  292.  
  293. constructor DialogBox.InitDeluxe(X1, Y1: word; Options: longint;
  294.                                  Colors: ColorSet;
  295.                                  Orientation: HorizVerticalType;
  296.                                  NrRows, NrCols: byte; CharExit: boolean;
  297.                                  NumTextLines, TotalTextChars,
  298.                                  NumChoices, TotalChoiceChars: word);
  299. begin
  300.   if not DialogBox.Init(Orientation, NumTextLines, TotalTextChars, NumChoices,
  301.                         TotalChoiceChars) then Fail;
  302.   dlX1 := X1;
  303.   dlY1 := Y1;
  304.   dlOptions := Options;
  305.   dlColors := Colors;
  306.   dlCharExit := CharExit;
  307.   dlNrRows := NrRows;
  308.   dlNrCols := NrCols;
  309. end;
  310.  
  311. destructor DialogBox.Done;
  312. begin
  313.   if dlEntry <> nil then Dispose(dlEntry, Done); {this also destoys dlButtons}
  314.   if dlChoices <> nil then Dispose(dlChoices,Done);
  315.   if dlText <> nil then Dispose(dlText,Done);
  316.   Root.Done;
  317. end;
  318.  
  319. procedure DialogBox.Clear;
  320. begin
  321.   dlPrompt := '';
  322.   dlpRow := 0;
  323.   dlpCol := 0;
  324.   dlPicture := '';
  325.   dlfRow := 0;
  326.   dlfCol := 0;
  327.   dlFieldRows := 0;
  328.   dlfWidth := 0;
  329.   dlHelpIndex := 0;
  330.   dlEditSt := '';
  331.   dlLastError := 0;
  332.   dlTimeOut := 0;
  333.   dlLastChoice := 0;
  334.   dlHeader := '';
  335.   if dlEntry <> nil then Dispose(dlEntry, Done); {this also destoys dlButtons}
  336.   dlEntry := nil;
  337.   dlButtons := nil;
  338.   if dlChoices <> nil then Dispose(dlChoices,Done);
  339.   if dlText <> nil then Dispose(dlText,Done);
  340.   dlText := New(MStringArrayPtr,Init(dlNumTextLines, dlTotalTextChars));
  341.   dlChoices := New(MStringArrayPtr,Init(dlNumChoices, dlTotalChoiceChars));
  342. end;
  343.  
  344. function DialogBox.GetLastError;
  345. begin
  346.   GetLastError := dlLastError;
  347.   dlLastError := 0;
  348. end;
  349.  
  350. procedure DialogBox.Process;
  351. var
  352.   LastCommand : word;
  353.   TimeOut : longint;
  354. begin
  355.   if not CreateBox then
  356.   begin
  357.     SimpStatus(ucULRoot, dlLastError, 'Creation DialogBox failed.');
  358.     Halt;
  359.   end;
  360.   if dlTimeOut <> 0 then
  361.   with dlEntry^ do
  362.   begin
  363.     Draw;
  364.     TimeOut := TimeMS + dlTimeOut;
  365.     Repeat until KeyPressed or (TimeMS > TimeOut);
  366.     if not KeyPressed then
  367.     begin
  368.       dlLastChoice := scTimeOut;
  369.       Exit;
  370.     end;
  371.   end;
  372.   with dlEntry^ do
  373.   begin
  374.     ClearErrors;
  375.     Repeat
  376.       Process;
  377.       LastCommand := GetLastCommand;
  378.     until (LastCommand = ccDone) or (LastCommand = ccError);
  379.     Erase;
  380.     if LastCommand = ccError then
  381.     begin
  382.       dlLastError := RawError;
  383.       SimpStatus(ucULDial, dlLastError, 'DialogBox problem.');
  384.       Abort;
  385.     end;
  386.     dlLastChoice := (dlButtons^.GetLastChoice - 1) div 3 + 1;
  387.   end;
  388. end;
  389.  
  390. procedure DialogBox.AddMessageString(Msg: string);
  391. var
  392.   status : word;
  393.   Len : byte absolute Msg;
  394. begin
  395.   if Len > (ScreenWidth - 2) then Len := ScreenWidth-2;
  396.   status := dlText^.AddMString(Msg);
  397.   if status = 0 then dlLastError := ecOutOfMemory;
  398. end;
  399.  
  400. procedure DialogBox.AddChoiceString(Choice: string);
  401. var
  402.   Status : word;
  403.   Temp : string;
  404.   Len : byte absolute temp;
  405.   i : byte;
  406. begin
  407.   i := 0;
  408.   Len := 1;
  409.   while Len <> 0 do
  410.   begin
  411.     Inc(i);
  412.     temp := ExtractWord(i,Choice,[' ']);
  413.     if Len <> 0 then status := dlChoices^.AddMString(temp);
  414.   end;
  415.   if status = 0 then dlLastError := ecOutOfMemory;
  416. end;
  417.  
  418. procedure DialogBox.AddChoice(Choice: string);
  419. var
  420.   status : word;
  421. begin
  422.   status := dlChoices^.AddMString(Choice);
  423.   if status = 0 then dlLastError := ecOutOfMemory;
  424. end;
  425.  
  426. procedure DialogBox.AddStringEntryField(Prompt: string; pRow, pCol: word;
  427.                               Picture: string; fRow, fCol: word;
  428.                               fWidth: byte; HelpIndex: word;
  429.                               EditSt: string);
  430. begin
  431.   dlPrompt := Prompt;
  432.   if pRow = fRow      then begin dlpRow := 1; dlfRow := 1; dlFieldRows := 1; end
  433.   else if pRow < fRow then begin dlpRow := 1; dlfRow := 2; dlFieldRows := 2; end
  434.   else                     begin dlpRow := 2; dlfRow := 1; dlFieldRows := 2; end;
  435.   dlpCol := pCol;
  436.   dlfCol := fCol;
  437.   dlPicture := Picture;
  438.   dlfWidth := fWidth;
  439.   dlHelpIndex := HelpIndex;
  440.   dlEditSt := EditSt;
  441. end;
  442.  
  443. function DialogBox.CreateBox: boolean;
  444. var
  445.   X1,Y1,X2,Y2 : byte;  {coordinates of RadioButtons}
  446.   Xs, Ys : byte;       {save desired location of EntryScreen}
  447.   WWidth, Twidth, Cwidth, Pwidth, Fwidth : word;
  448.   WHeight, THeight, PHeight : word;
  449.   status : word;
  450.   i : integer;
  451.   Line : string;
  452.   Len : byte absolute Line;
  453. begin
  454.   CreateBox := false;
  455.   if (dlEntry <> nil) and (dlButtons <> nil) then
  456.   begin
  457.     CreateBox := true;
  458.     Exit;
  459.   end;
  460.   { Check to see if called by InitDeluxe }
  461.   if dlX1 <> 0 then
  462.   begin
  463.     Xs := dlX1;
  464.     Ys := dlY1;
  465.   end
  466.   else Xs := 0;
  467.   WWidth := ScreenWidth - 2;
  468.   WHeight := ScreenHeight - 2;
  469.   Twidth := dlText^.GetMaxLen;
  470.   dlTNum := dlText^.NumStrings;
  471.   dlCNum := dlChoices^.NumStrings;
  472.   if (dlCNum = 0) then
  473.   begin
  474.     dlLastError := epFatal+ecNoChoice;
  475.     Exit;
  476.   end;
  477.   Cwidth := dlChoices^.GetMaxLen + 4;
  478.   { Calculate dimensions }
  479.   { If there is a string field calcualte total width }
  480.   if dlFieldRows > 0 then
  481.   begin
  482.     if dlpRow = dlfRow then
  483.     begin
  484.       Fwidth := dlfCol+dlfWidth-1;
  485.       if Fwidth > Wwidth then
  486.       begin
  487.         dlfWidth := Wwidth - dlfCol + 1;
  488.         Fwidth := Wwidth;
  489.       end;
  490.     end
  491.     else Fwidth := MaxWord(dlpCol+Length(dlPrompt)-1, dlfCol+dlfWidth-1);
  492.   end
  493.   else Fwidth := 0;
  494.   { Calculate for horizontal or vertical radio buttons }
  495.   if dlButOrient = rbHoriz then
  496.   begin
  497.     if dlNrCols < 2 then Pwidth := (dlCNum div dlNrRows) * Cwidth
  498.     else Pwidth := dlNrCols * Cwidth;
  499.     Pwidth := MinWord(WWidth, PWidth);
  500.     PHeight := 3 * dlNrRows;
  501.     Twidth := MinWord(WWidth, Twidth);
  502.     if dlTnum + PHeight + dlFieldRows > WHeight
  503.     then dlTnum := WHeight - PHeight - dlFieldRows
  504.     else WHeight := dlTNum + PHeight + dlFieldRows;
  505.     Twidth := MaxWord(Pwidth, Twidth);
  506.     { at this point Pwidth & PHeight are dimensions of RadioButton window
  507.       and Twidth & WHeight are dimensions of EntryScreen window }
  508.     { If there is a StringEntryField then, calculate widest.}
  509.     WWidth := MaxWord(FWidth, Twidth);
  510.     { at this point WWidth & WHeight are dimensions of EntryScreen window }
  511.     dlX1 := Center1(ScreenWidth,WWidth);
  512.     dlY1 := Center1(ScreenHeight,WHeight);
  513.     if Xs > 0 then
  514.     begin
  515.       dlX1 := GetGoodCoord(Xs,WWidth,ScreenWidth-2);
  516.       dlY1 := GetGoodCoord(Ys,WHeight,ScreenHeight-2);
  517.     end;
  518.     dlX2 := Coord2(dlX1,WWidth);
  519.     dlY2 := Coord2(dlY1,WHeight);
  520.     X1 := dlX1 + (WWidth-Pwidth) div 2;
  521.     X2 := Coord2(X1,PWidth);
  522.     Y1 := dlY2 - PHeight + 1;
  523.     Y2 := dlY2;
  524.   end
  525.   else {radio buttons are vertical }
  526.   begin
  527.     PWidth := dlNrCols * Cwidth;
  528.     if Pwidth > WWidth then
  529.     repeat
  530.       Dec(dlNrCols);
  531.       PWidth := dlNrCols * Cwidth;
  532.     until PWidth <= WWidth;
  533.     if dlNrRows < 2 then PHeight := (dlCnum div dlNrCols) * 3
  534.     else PHeight := dlNrRows * 3;
  535.     if (PHeight + dlFieldRows) > WHeight then PHeight := WHeight - dlFieldRows;
  536.     Twidth := MinWord(Twidth, Wwidth-Pwidth);
  537.     THeight := dlTnum + dlFieldRows;
  538.     if THeight > WHeight then
  539.     begin
  540.       dlTnum := WHeight - dlFieldRows;
  541.       THeight := dlTNum + dlFieldRows;
  542.     end;
  543.     WHeight := MaxWord(PHeight, THeight);
  544.     if dlFieldRows > 0 then
  545.     begin
  546.       if WHeight = PHeight then
  547.       begin
  548.         Fwidth := MinWord(Fwidth, Wwidth-Pwidth);
  549.         if dlpRow = dlfRow then
  550.           dlfWidth := MinWord(dlfWidth, Fwidth-dlfCol+1);
  551.       end;
  552.     end;
  553.     WWidth := MaxWord(FWidth+Pwidth, Twidth+PWidth);
  554.     dlX1 := Center1(ScreenWidth,WWidth);
  555.     dlY1 := Center1(ScreenHeight,WHeight);
  556.     if Xs > 0 then
  557.     begin
  558.       dlX1 := GetGoodCoord(Xs,WWidth,ScreenWidth-2);
  559.       dlY1 := GetGoodCoord(Ys,WHeight,ScreenHeight-2);
  560.     end;
  561.     dlX2 := Coord2(dlX1,WWidth);
  562.     dlY2 := Coord2(dlY1,WHeight);
  563.     X1 := dlX2 - PWidth + 1;
  564.     X2 := dlX2;
  565.     Y1 := dlY1;
  566.     Y2 := Y1 + PHeight - 1;
  567.   end;
  568.   if (dlFieldRows <> 0) and (dlButOrient = rbHoriz) then
  569.   begin
  570.     if (Fwidth < WWidth) then
  571.     begin
  572.       Twidth := (WWidth - Fwidth) div 2;
  573.       dlpCol := dlpCol + Twidth;
  574.       dlfCol := dlfCol + Twidth;
  575.     end;
  576.   end;
  577.   dlButtons := New(RadioButtonsPtr,Init(X1,Y1,X2,Y2,dlColors,
  578.                wClear+wNoCoversBuffer, dlButOrient, dlNrRows,dlNrCols,
  579.                dlCharExit, SingleChoice, DefPickOptions-pkStick, dlChoices));
  580.   if dlButtons = nil then Exit;
  581.   dlEntry := New(EntryScreenPtr, InitCustom(dlX1,dlY1,dlX2,dlY2,
  582.                  dlColors, dlOptions));
  583.   if dlEntry = nil then Exit;
  584.   {$IFDEF UseMouse}
  585.   if MouseInstalled then
  586.   begin
  587.     PickCommands.cpOptionsOn(cpEnableMouse);
  588.     EntryCommands.cpOptionsOn(cpEnableMouse);
  589.     MouseGotoXY(X1+1,Y1+1);
  590.   end;
  591.   {$ENDIF}
  592.   dlButtons^.SetErrorProc(SimpStatus);
  593.   with dlEntry^ do
  594.   begin
  595.     SetErrorProc(SimpStatus);
  596.     if dlHeader <> '' then wFrame.AddHeader(dlHeader, dlHeaderPos);
  597.     if (dlOptions and wBordered) = wBordered
  598.     then wFrame.AddShadow(shBR, shSeeThru);
  599.     for i := 1 to dlTNum do
  600.     begin
  601.       Line := dlText^.GetStringPtr(i)^;
  602.       if dlButOrient = rbHoriz then Line := Center(Line,WWidth);
  603.       AddTextField(Line,i,1);
  604.     end;
  605.     if dlFieldRows > 0 then
  606.     begin
  607.       esFieldOptionsOff(efAutoAdvance);
  608.       AddStringField(dlPrompt,dlTNum+dlpRow,dlpCol,dlPicture,
  609.                      dlTNum+dlfRow,dlfCol,dlfWidth,
  610.                      dlHelpIndex,dlEditSt);
  611.     end;
  612.     { add in radio buttons }
  613.     X1 := X1 - dlX1 + 1;
  614.     Y1 := Y1 - dlY1 + 1;
  615.     AddWindowField('',Y1,X1,Y1,X1, dlHelpIndex, dlButtons^);
  616.     dlLastError := RawError;
  617.     if dlLastError <> 0 then Exit;
  618.   end;
  619.   CreateBox := true;
  620. end;
  621.  
  622. procedure DialogBox.AddHeader(S: string; Posn: HeaderPosType);
  623. begin
  624.   dlHeaderPos := Posn;
  625.   dlHeader := S;
  626. end;
  627.  
  628. function DialogBox.GetLastChoice: word;
  629. begin
  630.   GetLastChoice := dlLastChoice;
  631. end;
  632.  
  633. function DialogBox.GetEditedString: string;
  634. begin
  635.   GetEditedString := dlEditSt;
  636. end;
  637.  
  638. procedure DialogBox.SetTimeOut(Delay: word);
  639. begin
  640.   dlTimeOut := longint(1000*Delay);
  641. end;
  642.  
  643. (***************************)
  644.  
  645. {Initialization}
  646. begin
  647.   ButtonFrame := SglWindowFrame;
  648. end.
  649.