home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_tmnu / stitmdem.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-07-06  |  6.1 KB  |  132 lines
  1. program STITDEM;                            { example of the TEXT MENU unit }
  2.  
  3. uses
  4.   CRT,                                      { standard CRT unit             }
  5.   STI_SCRF,                                 { screen functions unit         }
  6.   STI_KEYS,                                 { keyboard handler              }
  7.   STI_TMNU;                                 { the menu system               }
  8.  
  9. Var
  10.   Choice       : integer;                   { for choice values             }
  11.   ExitFlag     : boolean;                   { has the menu system been quit }
  12.   Win          : WindowSave;                { saved window                  }
  13.   KeyStroke    : KeyRec;                    { the last recorded keystroke   }
  14.   PassBack     : boolean;                   { shall we pass back characters }
  15.  
  16. {procedure menudata; external;  }             { this is not a procedure. it is}
  17. { sample.obj}                             { a pointer to the menu data    }
  18.                                             { that is linked in             }
  19.  
  20. {---------------------------------------------------------------------------}
  21.  
  22. procedure ReportStatus;                     { tell the user what happened   }
  23.  
  24. Var
  25.   Inch : char;                              { dummy variable                }
  26.  
  27. begin
  28.   while KeyPressed do                       { clear out the buffer          }
  29.     Inch := ReadKey;
  30.   MakeWindow(Win,                           { open a window                 }
  31.              20,19,50,24,                   { screen coordinates            }
  32.              White,                         { text color                    }
  33.              Yellow,                        { border color                  }
  34.              White+Reverse,                 { title color                   }
  35.              ROUNDCORNERSINGLE,             { border type                   }
  36.              'Report');                     { title                         }
  37.   GotoXY(21,20);                            { report the memory status      }
  38.   write('Memory  : ',MaxAvail);
  39.   GotoXY(21,21);
  40.   write('Choice  : ',Choice);               { the choice                    }
  41.   GotoXY(21,22);
  42.   write('Flag    : ',ExitFlag);             { and the flag, along with      }
  43.   GotoXY(21,23);
  44.   Write('Press any key...');                { a message                     }
  45.   repeat until keypressed;                  { wait for a key stroke         }
  46.   Inch := ReadKey;                          { read the key                  }
  47.   DisposeWindow(Win);                       { close the window              }
  48. end;
  49.  
  50. {---------------------------------------------------------------------------}
  51.  
  52. procedure HelpMessage(Message : string);    { write a message to the screen }
  53.  
  54. Var
  55.   Win   : WindowSave;                       { saved window                  }
  56.   Inch  : char;                             { dummy variable                }
  57.  
  58. begin
  59.   while KeyPressed do                       { clear the buffer              }
  60.     Inch := ReadKey;
  61.   MakeWindow(Win,                           { open a window                 }
  62.              5,10,55,12,                    { screen coordinates            }
  63.              White,                         { text color                    }
  64.              Yellow,                        { border color                  }
  65.              White+Reverse,                 { title color                   }
  66.              ROUNDCORNERSINGLE,             { border type                   }
  67.              'Help Message');               { title                         }
  68.   GotoXY(6,11);                             { goto the start and write      }
  69.   Write(Message);                           { the message                   }
  70.   repeat until keypressed;                  { wait a bit                    }
  71.   Inch := readKey;                          { read the keystroke            }
  72.   DisposeWindow(Win);                       { close the window              }
  73. end;
  74.  
  75. {---------------------------------------------------------------------------}
  76. {$F+}
  77. procedure Help(MenuNum,SelectNum : word);   { help procedure                }
  78.  
  79. begin
  80.   case MenuNum of                           { which menu ?                  }
  81.     1  : begin
  82.            case SelectNum of                { which selection ?             }
  83.              1 : HelpMessage('This is the file control menu');
  84.            end;
  85.          end;
  86.   end;
  87. end;
  88. {$F-}
  89. {---------------------------------------------------------------------------}
  90. {$F+}
  91. function Validate(MenuNum,SelectNum : word) : boolean; { check if this can  }
  92.                                                        { be selected        }
  93. begin
  94.   if (MenuNum = 7) and (SelectNum = 5) then
  95.     Validate := FALSE
  96.   else
  97.     Validate := TRUE;
  98. end;
  99. {$F-}
  100. {---------------------------------------------------------------------------}
  101. {$F+}
  102. function AllowExit(MenuNum,SelectNum : word) : boolean; { check if we can   }
  103.                                                         { exit from here    }
  104. begin
  105.   if (MenuNum = 2) and (SelectNum = 9) then
  106.     AllowExit := TRUE
  107.   else
  108.     AllowExit := FALSE;
  109. end;
  110. {$F-}
  111. {---------------------------------------------------------------------------}
  112.  
  113. begin
  114.   PassBack := TRUE;
  115.   Choice := STI_MenusInit('Sample.mnu',               { initialise the menu system    }
  116.                           @Help,            { no file name is needed as the }
  117.                           @Validate,        { menu definition is linked in  }
  118.                           @AllowExit,       { at menudata                   }
  119.                           NIL);
  120.   repeat
  121.     Choice := STI_GetMenuChoice(PassBack,   { shall we pass back hot keys   }
  122.                                 ExitFlag,   { loop and get a selection      }
  123.                                 KeyStroke); { the keystroke buffer          }
  124.     ReportStatus;                           { and report status to user     }
  125.     if PassBack and ExitFlag                { check for passed back keys    }
  126.                 and (Choice = 0) then
  127.       begin
  128.         ExitFlag := FALSE;                  { so we don't quit              }
  129.       end;
  130.   until ExitFlag;                           { until we can exit             }
  131. end.
  132.