[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]

    {
    > I wrote a procedure that read a string input from the keyboard and
    > returns an integer value. But how can I limit the length of the string
    > to be inputed? And can any one please provide a source code that does
    > the same thing in graphic mode? Thanx in advance.

       This is old Code, Written originally for a Hercules card, but with a
     little twiddling it should work just fine.  Improvements I can think
     of, Making the cursor blink, Making the cursor the correct size...

        Anyway, here goes.   Hang on this is pretty long!
    }

    {****************************************************************************}
    {                  Unit to Compute in a Very Pascal Way                      }
    {****************************************************************************}
    {                     Incredible Graphix Utilities                           }
    {****************************************************************************}
    {****************************************************************************}
    {     Version : 3.0                                         JUL  1993        }
    {****************************************************************************}
    Unit Grfxutil ;
    {****************************************************************************}
    Interface
    {****************************************************************************}
    type
         commands = (NON,F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12,F13,F14,F15,F16,
            F17,F18,F19,F20,F21,F22,F23,F24,F25,F26,F27,F28,F29,F30,F31,F32,F33,
            F34,F35,F36,F37,F38,F39,F40,HOME,UP,PGUP,LFT,RGHT,END1,DWN,PGDN,INS,
            DEL,PRTSRN,ENT,TAB,SPACE,BKSPAC,ESC,SHTAB,CTRLLFT,CTRLRGHT,CTRLUP,
            CTRLDWN,CTRLHOME,CTRLEND1,CTRLPGUP,CTRLPGDN) ;
    var
       Greypic     : pointer ;              { The Grey Picture                   }
       comm        : commands ;             { The Command from the keyboard      }
       NoEcho      : Boolean ;              { If Characters are echoed.          }
       Cwn         : String ;
    {****************************************************************************}
    Function Testbit(testin : longint ; position : byte) : boolean ;
    Function SetBit(Testin : longint ; Position : byte) : longint ;
    Procedure Report_Mouse_Position ;  { A Debuging and design tool }
    Procedure Register_Graphics
                 (videodriver,videomode : integer ; var videographicsmode : byte) ;
    Procedure clrvp(l1,l2,l3,l4 : integer ) ;
    Procedure SAP( P : byte ) ;
    Procedure clrpage ;
    procedure DblBox (X1,Y1,X2,Y2 : Integer) ;
    Procedure Dblwindowbox(x1,y1,x2,y2 : integer ; boxheader : string) ;
    Procedure WindowBox(x1,y1,x2,y2 : integer ; boxheader : string) ;
    Function  Roll(faces : integer) : integer ;
    Function  Getcommand(VAR ch : char) : commands ;

    { These are the ones you are interested in. }

    Procedure Readxy (X,Y:integer; Var S : string ; L : integer) ;
    Function  GetReal(X,Y : integer; am : real; w : integer) : real ;
    Function  getInteger(X,Y,N,W : integer) : integer  ;
    Procedure Greyoutxy(x,y : integer ; textstring : string) ;
    Function YesNoDialog : boolean ;
    {****************************************************************************}
    implementation uses crt,dos,Graph,bgidriv,bgifont,mousutil;
    {****************************************************************************}
    Function TestBit ;
    var
       maskbit : longint ;
    begin
         case position of
         1   : maskbit := 1 ;
         2   : maskbit := 2 ;
         3   : maskbit := 4 ;
         4   : maskbit := 8 ;
         5   : maskbit := 16 ;
         6   : maskbit := 32 ;
         7   : maskbit := 64 ;
         8   : maskbit := 128 ;
         9   : maskbit := 256 ;
         10  : maskbit := 512 ;
         11  : maskbit := 1024 ;
         12  : maskbit := 2048 ;
         13  : maskbit := 4096 ;
         14  : maskbit := 8192 ;
         15  : maskbit := 16384 ;
         16  : maskbit := 32768 ;
         17  : maskbit := 65536 ;
         18  : maskbit := 131072 ;
         19  : maskbit := 262144 ;
         20  : maskbit := 524288 ;
         21  : maskbit := 1048576 ;
         22  : maskbit := 2097152 ;
         23  : maskbit := 4194304 ;
         24  : maskbit := 8388608 ;
         25  : maskbit := 16777216 ;
         26  : maskbit := 33554432 ;
         27  : maskbit := 67108864 ;
         28  : maskbit := 134217728 ;
         29  : maskbit := 268435456 ;
         30  : maskbit := 536870912 ;
         31  : maskbit := 1073741824 ;
         end ;
         if (testin and maskbit) = maskbit then testbit := true
         else testbit := false ;
    end ;

    {****************************************************************************}
    { This function sets the state of a bit in a variable as large as a longint.
    You call it with the value of the variable and the position (counting from
    right to left naturally).  If the bit is already set, then it will turn it
    off, if it is off then it will turn it on. }
    Function setBit ;
    var
       maskbit : longint ;
    begin
         case position of
         1   : maskbit := 1 ;
         2   : maskbit := 2 ;
         3   : maskbit := 4 ;
         4   : maskbit := 8 ;
         5   : maskbit := 16 ;
         6   : maskbit := 32 ;
         7   : maskbit := 64 ;
         8   : maskbit := 128 ;
         9   : maskbit := 256 ;
         10  : maskbit := 512 ;
         11  : maskbit := 1024 ;
         12  : maskbit := 2048 ;
         13  : maskbit := 4096 ;
         14  : maskbit := 8192 ;
         15  : maskbit := 16384 ;
         16  : maskbit := 32768 ;
         17  : maskbit := 65536 ;
         18  : maskbit := 131072 ;
         19  : maskbit := 262144 ;
         20  : maskbit := 524288 ;
         21  : maskbit := 1048576 ;
         22  : maskbit := 2097152 ;
         23  : maskbit := 4194304 ;
         24  : maskbit := 8388608 ;
         25  : maskbit := 16777216 ;
         26  : maskbit := 33554432 ;
         27  : maskbit := 67108864 ;
         28  : maskbit := 134217728 ;
         29  : maskbit := 268435456 ;
         30  : maskbit := 536870912 ;
         31  : maskbit := 1073741824 ;
         end ;
         setbit := testin xor maskbit ;
    end ;

    {****************************************************************************}

    Procedure Report_Mouse_position ;
    { This is a debugging and Designing tool, it reports the X,Y position of the
    mouse and shows free memory in the upper right corner of the screen. }
    var
       msxstr,msystr : string[6] ;
       Memstr : string[10] ;

    Begin
         str(memavail,memstr) ;
         str(getmousex,msxstr) ;
         str(getmouseY,msystr) ;
         msxstr := 'X: ' + msxstr ;
         msystr := 'Y: ' + msystr ;
         settextstyle(0,0,1) ;
         setfillstyle(solidfill,darkgray) ;
         bar(getmaxx-30,3,getmaxx-4,20) ;
         bar(530,5,580,15) ;
         setcolor(white) ;
         outtextxy(530,5,memstr);
         outtextxy(getmaxx-53,4,msxstr) ;
         outtextxy(getmaxx-53,13,msystr) ;
    end ;
    {****************************************************************************}
    { Loads and registers the graphics driver }
    Procedure Register_Graphics
    (videodriver,videomode : integer ; var videographicsmode : byte) ;
    var
      GraphDriver, GraphMode, Error : integer;
      gotgrafix : boolean ;
      mode : byte ;
      regs : registers ;
    {*************************************************}
    procedure Abort(Msg : string);
    begin
      Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
      Halt(4);
    end;
    {*************************************************}
    begin   { Register Graphix  }
         if RegisterBGIdriver(@EGAVGADriverProc) < 0 then Abort('EGA/VGA');
    {     if RegisterBGIdriver(@HercDriverProc) < 0 then Abort('Herc');
         if RegisterBGIdriver(@ATTDriverProc) < 0 then Abort('AT&T');
         if RegisterBGIdriver(@PC3270DriverProc) < 0 then Abort('PC 3270');
    }
                               { Register all the fonts }
    {     if RegisterBGIfont(@GothicFontProc) < 0 then Abort('Gothic');
         if RegisterBGIfont(@SansSerifFontProc) < 0 then Abort('SansSerif');
         if RegisterBGIfont(@SmallFontProc) < 0 then Abort('Small');
         if RegisterBGIfont(@TriplexFontProc) < 0 then Abort('Triplex');
    }     graphdriver := videodriver ;
         graphmode := videomode ;

         initgraph(graphdriver,graphmode,'') ;
         if GraphResult <> grOk then             { any errors? }
         begin
              Writeln('Graphics init error: ', GraphErrorMsg(GraphDriver));
              Halt(4);
         end;
    End ; { Register Graphics }

    {****************************************************************************}
    { Clears a viewport passed to it and resets the viewport }
    { instead of writing it so many times!! }
    Procedure clrvp(l1,l2,l3,l4 : integer ) ;
    var
       vp : viewporttype ;
    begin
         getviewsettings(vp) ;
         setviewport(l1,l2,l3,l4,clipon) ;
         clearviewport ;
         setviewport(vp.x1,vp.y1,vp.x2,vp.y2,vp.clip) ; { Restore the viewport }
    end ;
    {****************************************************************************}
    { Sets Apage, activepage, visualpage }
    Procedure SAP ;

    begin   { SAP }
         setactivepage(p) ; setvisualpage(p) ;
    end ;   { SAP }
    {****************************************************************************}
    { Clears the current page number }
    Procedure clrpage ;

    begin   { Clrpage }
         clrvp(0,0,getmaxx,getmaxy) ;
    end ;   { Clrpage }
    {****************************************************************************}
    { Puts down a double Lined Box }
    procedure DblBox ;

    begin   { DblBox }
         line(x1,y1,x2,y1) ; line(x1 + 2,y1 + 2,x2 - 2,y1 + 2) ;
         line(x1,y2,x2,y2) ; line(x1 + 2,y2 - 2,x2 - 2,y2 - 2) ;
         line(x1,y1,x1,y2) ; line(x1 + 3,y1 + 3,x1 + 3,y2 - 3) ;
         line(x2,y1,x2,y2) ; line(x2 - 3,y1 + 3,x2 - 3, y2 - 3) ;
    end ;   { DblBox }
    {****************************************************************************}
    { Creates a double lined box with an optional header }
    Procedure Dblwindowbox(x1,y1,x2,y2 : integer ; boxheader : string) ;
    var
       oldstyle : textsettingstype ;
    begin
         line(x1,y1,x2,y1) ;
         if length(boxheader) = 0 then line(x1 + 2,y1 + 2,x2 - 2,y1 + 2)
         else line(x1,y1 + textheight('H') + 2,x2,y1 + textheight('H') + 2) ;
         line(x1,y2,x2,y2) ;
         line(x1 + 2,y2 - 2,x2 - 2,y2 - 2) ;
         line(x1,y1,x1,y2) ;
         line(x1 + 2,y1 + 2,x1 + 2,y2 - 2) ;
         line(x2,y1,x2,y2) ;
         line(x2 - 2,y1 + 2,x2 - 2, y2 - 2) ;
         line(x1+2,y1,x1+2,y1+10) ;
         line(x2-2,y1,x2-2,y1+10) ;
         if length(boxheader) >0 then
         begin
              gettextsettings(oldstyle);
              settextjustify(1,0) ;
              outtextxy(x1+ ((x2-x1) div 2),y1+ textheight('H') + 2,boxheader) ;
              with oldstyle do
              begin
                   settextjustify(horiz,vert) ;
                   settextstyle(font,direction,charsize) ;
              end ;
         end ;
    end ;
    {****************************************************************************}
    { Creates a Single lined box with an optional header }
    Procedure windowbox(x1,y1,x2,y2 : integer ; boxheader : string) ;
    var
       oldstyle : textsettingstype ;
    begin
         line(x1,y1,x2,y1) ;
         if length(boxheader) > 0 then
          line(x1,y1 + textheight('H') + 2,x2,y1 + textheight('H') + 2) ;
         line(x1,y2,x2,y2) ;
         line(x1,y1,x1,y2) ;
         line(x2,y1,x2,y2) ;
         if length(boxheader) >0 then
         begin
              gettextsettings(oldstyle);
              settextjustify(1,0) ;
              outtextxy(x1+((x2-x1) div 2),y1+textheight('H') + 1,boxheader) ;
              with oldstyle do
              begin
                   settextjustify(horiz,vert) ;
                   settextstyle(font,direction,charsize) ;
              end ;
         end ;
    end ;

    {****************************************************************************}
    { An Any sided Die }
    Function Roll(faces : integer) : integer ;
    begin
         roll := random(faces) + 1 ;
    end ;
    {****************************************************************************}
    { Returns A Commandkey From A Keypress or a Character }
    { The Function will return a command and it will  record the key in
    the variable parameter.  So you can use it to find any key pressed on
    the keyboard.}
    Function  Getcommand(VAR ch : char) : commands ;
    Var
         C : Commands ;
         funckey : boolean ;
         newcommand : boolean ;

    Begin  { Get Command }
         newcommand := false ;
         C := NON ;
         if keypressed then
         begin
              newcommand := true ;
              Ch := Readkey ;
         end ;
         if newcommand then
         begin  { get the command }
         If Ch <> #0 Then Funckey := False
         Else
         Begin
              Funckey := True ;
              Ch := Readkey ;
         End ;
         If Funckey Then
         Case Ch Of
     { The Normal Function Keys }
         #59 : C := F1 ;        {F1}
         #60 : C := F2 ;        {F2}
         #61 : C := F3 ;        {F3}
         #62 : C := F4 ;        {F4}
         #63 : C := F5 ;        {F5}
         #64 : C := F6 ;        {F6}
         #65 : C := F7 ;        {F7}
         #66 : C := F8 ;        {F8}
         #67 : C := F9 ;        {F9}
         #68 : C := F10 ;       {F10}
       { Shifted Function Keys }
         #133,#84 : C := F11 ;  {F11}
         #134,#85 : C := F12 ;  {F12}
         #86 : C := F13 ;       {F13}
         #87 : C := F14 ;       {F14}
         #88 : C := F15 ;       {F15}
         #89 : C := F16 ;       {F16}
         #90 : C := F17 ;       {F17}
         #91 : C := F18 ;       {F18}
         #92 : C := F19 ;       {F19}
         #93 : C := F20 ;       {F20}
       { Cntl Function Keys }
         #94 : C := F21 ;       {F21}
         #95 : C := F22 ;       {F22}
         #96 : C := F23 ;       {F23}
         #97 : C := F24 ;       {F24}
         #98 : C := F25 ;       {F25}
         #99 : C := F26 ;       {F26}
         #100 : C := F27 ;      {F27}
         #101 : C := F28 ;      {F28}
         #102 : C := F29 ;      {F29}
         #103 : C := F30 ;      {F30}

       { Alt Function Keys }
         #104 : C := F31 ;      {F31}
         #105 : C := F32 ;      {F32}
         #106 : C := F33 ;      {F33}
         #107 : C := F34 ;      {F34}
         #108 : C := F35 ;      {F35}
         #109 : C := F36 ;      {F36}
         #110 : C := F37 ;      {F37}
         #111 : C := F38 ;      {F38}
         #112 : C := F39 ;      {F39}
         #113 : C := F40 ;      {F40}
             { The Keypad }
         #71 : C := HOME;   {HOME}
         #72 : C := UP ;   {UP}
         #73 : C := PGUP ;   {PGUP}
         #75 : C := LFT ;   {LEFT}
         #77 : C := RGHT ;   {RIGHT}
         #79 : C := END1 ;   {END}
         #80 : C := DWN ;   {DOWN}
         #81 : C := PGDN ;   {PGDN}
         #82 : C := INS ;   {INS}
         #83 : C := DEL ;   {DEL}
         #114 : C := PRTSRN ; { Cntl - PrtSc }
         #15 : C := SHTAB ;  { Shft Tab }
         End  { Case }
         else    { Not a function Key }
         case ch of
         #13 : C := ENT ;    { Return }
         #27 : C := ESC ;    { Escape }
         #32 : C := SPACE ;  { Space Bar }
         #9  : C := TAB ;    { Tab }
         #8  : C := BKSPAC ; { Back Space }
         end ;   { Case }
         end ;
         Getcommand := C ;
    End ;  {Getcommand}
    {****************************************************************************}
    Procedure readxy ;

    Var
         Ch : Char ;
         Done,Nomore,Inson,Funckey,curson : Boolean ;
         Curp,Cx,Cy,Sx,Sy,StrCnt,I,x1,x2,y1,y2 : Integer ;
         Outstr : string ;
         cmmd : commands ;
         Spac : integer ;
    {*******************************************}
    { Place the Cursor and update the cursor on flag }
    { With I we can force the cursor on or off or let it operate automaticly
    if I = 0 then turn the cursor off, if 1 then automatic, if 2 then on. }
    Procedure PpCur(I : integer) ;
    var
       udc : boolean ;
    begin   { ppcur }
         udc := false ;
         if (cx >= x1) and (cx < x2) then udc := true ;
         if udc then
         begin
              case I of
              0 : setcolor(black) ;
              1 : if curson then setcolor(black) else setcolor(white) ;
              2 : setcolor(white) ;
              end ;
              if inson then setlinestyle(0,$FFFF,3) else setlinestyle(0,$FFFF,1) ;
              line(cx,cy+textheight('H')+1,cx+textwidth('X'),cy+textheight('H')+1)
    ;          curson := not(curson) ;
              if I = 2 then curson := true ;
              if I = 0 then curson := false ;
         end ;
         setcolor(white) ;
    end ;   { ppcur }

    {*******************************************}
    { Go to the end of the line, wherever it may be... }
    Procedure Goend ;
    Begin
         ppcur(0) ; { Erase the old cursor }
         Cx := Sx + Length(S) * Spac ;
         Strcnt := Length(S) + 1 ;
         ppcur(2) ; { Place the new cursor }
    End ;

    {*******************************************}
    Begin   { Readpgrf }
         curson := false ; Strcnt := 1 ; Inson := False ;
         Outstr := '' ; Nomore := False ;
         spac := textwidth('X') ;
         Sx := X ;
         Sy := Y ;
         Cx := Sx ;
         Cy := Sy ;    { Set the Current x & y }

         y2 := y + spac ;
         x1 := x ;
         x2 := x1 + L * spac ;
         y1 := y ;
         moveto(x,y) ;
         outtext(S) ;
         ppcur(2) ;
         Done := False ; While Not Done Do
         Begin
              ch := chr(1) ; { Clears the char }
              cmmd := getcommand(ch) ;
              if (cmmd <> NON) and (cmmd <> SPACE) then
              Case CMMD Of
              HOME : Begin   {HOME}
                          Strcnt := 1 ;
                          ppcur(1) ;
                          Cx := Sx ;
                          Cy := Sy ;
                          ppcur(2) ;
                     End ;
              LFT  : Begin   { Left }
                          If Cx >= X1 + Spac Then
                          Begin
                               if cx <= x2 - spac then ppcur(1) ;
                               Cx := Cx - Spac ;
                               ppcur(2) ;
                               Dec(Strcnt) ;
                               If Strcnt < 1 Then Strcnt := 1 ;
                          End ;
                     End ;  { UP }
              RGHT : Begin   { Right }
                          If Cx < X2 - Spac Then
                          Begin
                               ppcur(1) ;
                               Cx := Cx + Spac ;
                               ppcur(1) ;
                               If Strcnt = Length(S) + 1 Then
                               Begin
                                    Insert(' ',S,Strcnt) ;
                                    outtextxy(Cx,Cy,' ') ;
                                    Inc(Strcnt) ;
                               End
                               Else Inc(Strcnt) ;
                          end ;
                     End ;   {RIGHT}
              END1 : Goend ;
              INS  : Begin   { INS }

                          If Inson = False Then
                          begin
                          If Integer(Length(S) * Spac)
                           < Integer(X2 - X1 - Spac) Then Inson := True ;
                          end else
                          begin
                               ppcur(0) ;
                               Inson := False ;
                          end ;
                          ppcur(2) ;
                     End ;   { INS }
              DEL  : If Strcnt < Length(S) + 1 Then
                     Begin
                          Delete(S,Strcnt,1) ;
                          Moveto(Cx,Cy) ;
                          For I := Strcnt To Length(S) Do
                           if noecho then Outstr := outstr + '.'
                            else outstr := Outstr + S[I] ;
                          clrvp(Cx,Cy,X2,Y2) ;
                          Outtextxy(cx,cy,Outstr) ;
                          Outstr := '' ;
                          ppcur(2) ;
                     End ;
              BKSPAC : If Strcnt > 1 Then
                     Begin
                          If Cx <= X2 - Spac Then
                          ppcur(0) ;
                          dec(Cx,Spac) ;   { Right - Normal   }
                          If Cx < 0 Then Cx := 0 ;
                          Nomore := False ;
                          Dec(Strcnt) ;
                          If Strcnt < Length(S) Then
                          Begin
                               Moveto(Cx,Cy) ;
                               Delete(S,Strcnt,1) ;
                               For I := Strcnt To Length(S) Do
                                if noecho then Outstr := outstr + '.'
                                else Outstr := Outstr + S[I] ;
                               clrvp(Cx,cy,x2,y2) ;
                               Outtextxy(cx,cy,Outstr) ;
                               Outstr := '' ;
                               ppcur(2) ;
                          End
                          Else
                          Begin
                               ppcur(0) ;
                               If Length(S) <= 1 Then
                                S:= '' Else Delete(S,Strcnt,1) ;
                                clrvp(cx,cy,x2,y2) ;
                                ppcur(2) ;
                          End ;
                     End ;
              ESC :  Begin  { ESC }
                          ppcur(1) ;
                          S := '' ;
                          clrvp(X1,Y1,X2,Y2) ;
                          Cx := Sx ; Cy := Sy ;
                          ppcur(1) ;
                          nomore := false ;
                          Strcnt := 1 ;
                     End ;
              ENT   : Done := True ;      { Return }
              end  { Case cmmd }
              Else   { Not a command But A Key }
              case ch of
              ' '..'~':     Begin
                             If Integer(Length(S) * Spac) >
                                   (x2 - X1 - Spac) Then Nomore := True ;
                             If (Inson = False)
                                      And
                                (Strcnt < Length(S) + 1)
                                Then Nomore := False ;
                             If Not Nomore Then
                             Begin { Not Nomore }
                                  ppcur(1) ;
                                  If Inson Then
                                  Begin  { Inson }
                                       Insert(Ch,S,Strcnt) ;
                                       If Strcnt < Length(S) Then
                                       Begin  { < Length }
                                       clrvp(Cx,Cy,X2,Y2) ;
                                            Moveto(Cx,Cy) ;
                                            For I := Strcnt To Length(S) Do
                                             if noecho then Outstr := outstr + '.'
                                             else Outstr := Outstr + S[I] ;
                                            Outtext(Outstr) ;
                                            Outstr := '' ;
                                            Inc(Strcnt) ;
                                       End  { < Length }
                                       Else
                                       Begin  { = Length }
                                            if noecho then outtextxy(cx,cy,'.')
                                            else outtextxy(Cx,Cy,ch) ;
                                            curson := false ;
                                            Inc(Strcnt) ;
                                       End ;  { = Length }
                                  End { Inson }
                                  Else
                                  Begin  { Ins Off }
                                       Delete(S,Strcnt,1) ;
                                       Insert(Ch,S,Strcnt) ;
                                       Inc(Strcnt) ;

    clrvp(cx,cy,cx+textwidth(ch),cy+textheight(ch)) ;
    if noecho then outtextxy(cx,cy,'.')                                   else
    outtextxy(Cx,Cy,ch) ;                                   if strcnt <= length(s)
    then                                       begin
                                                ch := s[strcnt] ;
                                                if noecho then outtextxy(cx,cy,'.')
                                                else outtextxy(Cx + spac,Cy,ch) ;
                                           end ;
                                       curson := false ;
                                  End ;  { Ins Off }
                                  Cx := Cx + Spac ;
                                  If Cx <= X2 - Spac Then ppcur(2) ;
                             End    { Not Nomore }
                        End ;   { Real Chars }
              End ; { Case }
         End ;    { Not Done  }
         S[0] := chr(length(s)) ;
         if curson then ppcur(0) ;
    End ;  {readxy}
    {****************************************************************************}
    { Get an Amount of Type Real from a Location }
    Function Getreal ;
    var
       istr : string ;
       cod : integer ;
    begin   { get Amount }
         str(am:1:2,istr) ;
         repeat
              readxy(x,y,istr,w) ; val(istr,am,cod) ;
         until cod = 0 ;
         getreal := am ;
    end ;   { get Amount }
    {****************************************************************************}
    { Get an Amount of type integer from a location x,y  }
    Function getinteger  ;
    var
       istr : string ;
       cod : integer ;
    begin   { Getinteger }
         str(n,istr) ;
         repeat
              readxy(X,y,istr,w) ; val(istr,n,cod) ;
         until cod = 0 ;
         getinteger := n ;
    end ;   { Getinteger }
    {****************************************************************************}
    { Outputs using Outtextxy then GREY's out the text }
    Procedure Greyoutxy(x,y : integer ; textstring : string) ;
    var
       size,I : integer ;

    begin
         size := textwidth(textstring) div length(textstring) ;
         outtextxy(x,y,textstring) ;
         for I := 0 to length(textstring)-1 do
            putimage(x + size*I,y,greypic^,andput) ;  { Greyout }
    end;
    {****************************************************************************}
    Function YesNoDialog : boolean ;
    const
         boxx = 150 ;
         Boxy = 150 ;
    Var
       menudone,Yesno : Boolean ;
       oldstyle : textsettingstype ;
       boxheight,boxwidth,oldcolor,numpressed : word ;
       msx,msy : word ;
       Imagebuffer : pointer ;
       Size : word ;

    begin  { YesNo Dialog }
         Yesno := false ;
         menudone := false ;
         hidemousecursor ;
         { Save what is under the window before opening it. Also save
            the old textstyle }
         gettextsettings(oldstyle) ;
         oldcolor := getcolor ;
         settextstyle(0,0,1) ;
         boxheight := textheight('H') * 3 ;
         Boxwidth := textwidth('H') * 15;
         size := imagesize(boxx,boxy,boxx + boxwidth,boxy + boxheight) ;
         getmem(imagebuffer,size) ;
         getimage(boxx,boxy,boxx + boxwidth,boxy + boxheight,imagebuffer^) ;

         { Now we put the image of the menu down. }
         setfillstyle(1,lightgray) ;
         bar(boxx+3,boxy+3,boxx + boxwidth-3,boxy + boxheight-3) ;
         setcolor(green) ;
         dblbox(boxx,boxy,boxx + boxwidth,boxy + boxheight) ;
         setcolor(brown) ;
         outtextxy(boxx+8,boxy+textheight('H'),' Yes  |  No') ;
         setcolor(oldcolor) ;
         showmousecursor ;
         repeat
              if (getmousex <> msx) or (getmousey <> msy) then
              begin
                   msx := getmousex ;
                   msy := getmousey ;
              end ;
              if buttonpressed then
              { where was the button pressed?}
              begin
                   msx := getmousex ;
                   msy := getmousey ;
                   if ((msx > boxx+4) and (msx < boxx+boxwidth))
                      and
                      ((msy > boxy) and (msy < boxy+boxheight)) then
                      { it's in the menu box }
                   begin
                        { where in the menu Box? }
                        if (msx > boxx) and (msx < boxx+ (boxwidth div 2))
                        then yesno := true ;
                        menudone := true ;
                   end ;
              end ;
         until menudone ;
         { when we are done we want to restore all the old settings. }
         with oldstyle do
         begin
              settextjustify(horiz,vert) ;
              settextstyle(font,direction,charsize) ;
         end ;
         { and put the screen back to what it was.. }
         hidemousecursor ;
         putimage(boxx,boxy,imagebuffer^,normalput) ;
         freemem(imagebuffer,size) ;
         showmousecursor ;
         setcolor(oldcolor) ;
         yesnodialog := yesno ;
    end;
    {****************************************************************************}
    End.   { End of grfxutil }
    {
        The routines you might be interested in are in the later half of
     that unit In the previous posts.  It provided a fully editable
     Graphical Data Entry (either string, real, or integer) line.  It
     supports the arrow keys, Home, end, backspace, del, insert, and escape
     clears the whole line.  Enter accepts the input.  You can specify how
     many characters wide the input field should be, and the numerical input
     routines, Getreal, and getinteger do some primitive checking to make
     sure that input is correct.  Also, (it's been a long time since I've
     used this so bear with my bad memory) I believe you call them with the
     value of an already initialized variable so that if the user just hits
     enter it doesn't change the value.  I've used it in conjunction with a
     mouse pointer and since the readxy routine is command driven (using the
     getcommand supplied in there too,) you can issue it an enter with the
     mouse buttons.  So you can click around in various fields with your
     mouse.  Of course you have to make that routine yourself!

        Oh!  I should tell you, delete the refferences to mouseutil and the
     single mouse function, sorry, I shouldn't have included that one with
     it.. You might not have mousutil!
    }

[Back to EGAVGA SWAG index] [Back to Main SWAG index] [Original]