Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/turbopas/pull20.arc/PULLPROC.PAS

Pascal/Delphi Source File | 1988-01-12 | 8.0 KB | 241 lines

{ =========================================================================== }
{ Pullproc.pas - Process procedures for pull-down menus.    ver 2.0, 01-12-87 }
{                                                                             }
{ This file contains all the procedures executed by Process.  These are       }
{ assigned to any choice in the menus.  They are organized by Main Menu       }
{ Pulled (MPulled), Submenu Pulled (SPulled), and Highlighted (HiLited).      }
{ (c) 1987,1988 James H. LeMay                                                }
{ =========================================================================== }

{$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }

UNIT PullProc;

INTERFACE

uses
  CRT,PullVars,Pull,PullStat,PullDir;

{ Your variables for DATA ENTRY TRANSFER go here.  Using CONST will give
  them an initial value. }
const
  aByte:      byte      =    129;
  Seats:      byte      =      4;
  Years:      byte      =     30;
  Month:      byte      =      1;
  Day:        byte      =     12;
  aWord:      word      =  50000;
  aInteger:   integer   = -31456;
  Year:       integer   =   1987;
  PriceLimit: integer   =   2000;
  aLongInt:   longint   = -123456789;
  aReal:      real      = -24.34565E06;
  aHex:       string[4] = 'FF03';
  aChar:      char      = 'Q';
  aString:    MaxString = 'This is a string';
  FileName:   string[12]= 'pulldemo.exe';
  WorkWndwInteger: integer     = 0;
  HexSet:          set of char = ['0'..'9','A'..'F','a'..'f',BSkey];

var
  OrigPathName,PathName: string[45];
  FileNameCharSet:       set of char;

procedure DataTransfer (VAR ErrMsg: word);
procedure Process (MPulled,SPulled,HiLited: byte);


IMPLEMENTATION

{ **************************** DATA ENTRY TRANSFER ************************** }
{ ---------------- Set up variables for data windows here: ------------------ }
{ Place your variables names here to interface with the menus.  HiLited
  is the selection on that menu that called for the DataWndw.                 }
{ Careful! -- there's NO type checking for parameters in Transfer.  You MUST  }
{ be certain case statement, DataWndw, and TypeOfData all match.  Be          }
{ especially careful of string lenths that are too long.                      }

procedure DataTransfer; { (VAR ErrMsg: word); }
var j: word;
begin
  with DataPad do
  begin
    if SPulled=0 then   { SPulled=0 when a Main Menu only is pulled. }
      case MainMenuNames(MPulled) of
        FilesMenu:
           case HiLited of
             1: begin
                  if StoreMode then
                    begin
                      {$I-} ChDir (Sdata); {$I+}
                      if IOresult=0 then
                        begin
                          Transfer (PathName);
                          GetDir (0,PathName);
                        end
                      else ErrMsg:=2;
                    end
                  else
                    begin
                      UserCharSet:=FileNameCharSet + [':','\'];
                      Transfer (PathName);
                    end;
                end;
             2: begin
                  if StoreMode then
                    begin
                      if Sdata='' then Sdata:='*.*';
                    end
                  else UserCharSet:=FileNameCharSet + ['*','?'];
                  Transfer (FileMask);
                end;
           end;
        AutoPartsMenu:
           case HiLited of
             3: Transfer (Seats);
           end;
        EnterDataMenu:
           case HiLited of
             1: Transfer (aByte);
             2: Transfer (aWord);
             3: Transfer (aInteger);
             4: Transfer (aLongInt);
             5: Transfer (aReal);
             6: begin
                  Transfer (aHex);
                  if StoreMode then
                    for j:=1 to ord(aHex[0]) do aHex[j]:=upcase(aHex[j])
                  else UserCharSet:=HexSet;
                end;
             7: Transfer (aChar);
             8: Transfer (aString);
           end;
        OptionsMenu:
           case HiLited of
                 { The following line shows how to place limits on data. }
             7: if StoreMode and ((Idata>2500) or (Idata<=0)) then ErrMsg:=3
                else Transfer (PriceLimit);
           end;
        IRSmenu:
           case HiLited of
             7: Transfer (Years);
           end;
      end
    else
      case SubMenuNames(SPulled) of
        DateMenu:
           case HiLited of
             1: if StoreMode and ((Bdata=0) or (Bdata>12)) then ErrMsg:=5
                else Transfer (Month);
             2: if StoreMode and ((Bdata=0) or (Bdata>31)) then ErrMsg:=6
                else Transfer (Day);
             3: if StoreMode and ((Idata<1960) or (Idata>2010)) then ErrMsg:=7
                else Transfer (Year);
           end;
      end  { case }
  end  { with }
end;

{ **************************** PROCESS MENU SELECTION *********************** }
{ Place procedures for Process here. }

procedure DummyProcess;
begin
  ShowMsg (8);
  Delay (1000)
end;

{ Place your procedure names here to interface with "Exec-" type menus. }

procedure Process; { (MPulled,SPulled,HiLited: byte); }   { LOCAL! }
var LastMsgLineNum: word;
begin
  LastMsgLineNum:=CurrentMsgLineNum;
  if SPulled=0 then   { SPulled=0 when a Main Menu only is pulled. }
    case MainMenuNames(MPulled) of
       FilesMenu:
          case HiLited of
            2: begin
                 PullDown:=true;
                 MoreCmdSeq:='D';
               end;
            3: PullDirectory (FileName,'');
               { use (FileName,FileName) to initially Hilite a close match }
           end;
       UtilitiesMenu:
          case HiLited of
            1..7: DummyProcess;
          end;
       IRSmenu:
          case HiLited of
            6: ;
            2..7: DummyProcess;
          end;
       QuitMenu:
          case HiLited of
            2: begin
                 PopToWorkWndw:=true;
                 Quit:=true
               end;
          end;
    end
  else
    case SubMenuNames(SPulled) of
      UpdateMenu:
         case HiLited of
           1: DummyProcess;
           2: begin
               { The following line are how you process first and then pop
                 the menu. }
                DummyProcess;
                PopToWorkWndw:=true
              end;
           3:  { The following line is how you pop the menus first and
                 then process. }
              if Popped then DummyProcess;
           4: begin
               { The following lines are how you pop the menus first,
                 process, and then pull the same menu(s) again which is good
                 for updating the work window. }
                if Popped then DummyProcess;
                PullDown:=true
              end;
           5: begin
               { The following lines are how you pop by a number of levels
                 so that part of the menus will remain displayed while
                 going to another submenu. }
                PopLevels:=1;
                PullDown:=true;
                MoreCmdSeq:='Y'
              end;
           6: begin
               { The following lines are how you go to a completely
                 different menu. }
                PopToTop:=true;
                PullDown:=true;
                MoreCmdSeq:='AR'
              end;
         end;
        { The following is how to enter a sequence of entries. }
      DateMenu:
         case HiLited of
           1: begin
                PullDown:=true;
                MoreCmdSeq:='D'
              end;
           2: begin
                PullDown:=true;
                MoreCmdSeq:='Y'
              end;
           3: PopLevels:=1;
         end;
    end;  { case }
  if not(PopToWorkWndw or PopToTop or (PopLevels>0) or PullDown) then
    ShowMsg (LastMsgLineNum);
end;

BEGIN
  AddrDataTransfer:=@DataTransfer;
  AddrProcess     :=@Process;
END.