home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mailpro / state.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  3.0 KB  |  92 lines
  1. unit State;
  2.  
  3. interface
  4. uses Crt, Def, ColorDef, FastWr, GetKeU, SetAttU, DrawSqar, SetBU, LPaU;
  5. const
  6. StateTop  : integer = 13;
  7. StateLine : array [1..13] of Line = (
  8. 'AL Alabama          IN Indiana          NE Nebraska         SC South Carolina',
  9. 'AK Alaska           IA Iowa             NV Nevada           SD South Dakota',
  10. 'AZ Arizona          KS Kansas           NH New Hampshire    TN Tennessee',
  11. 'AR Arkansas         KY Kentucky         NJ New Jersey       TX Texas',
  12. 'CA California       LA Louisiana        NM New Mexico       UT Utah',
  13. 'CO Colorado         ME Maine            NY New York         VT Vermont',
  14. 'CT Connecticut      MD Maryland         NC North Carolina   VA Virginia',
  15. 'DE Delaware         MA Massachusetts    ND North Dakota     WA Washington',
  16. 'FL Florida          MI Michigan         OH Ohio             WV West Virginia',
  17. 'GA Georgia          MN Minnesota        OK Oklahoma         WI Wisconsin',
  18. 'HI Hawaii           MS Mississippi      OR Oregon           WY Wyoming',
  19. 'ID Idaho            MO Missouri         PA Pennsylvania        -------  ',
  20. 'IL Illinois         MT Montana          RI Rhode Island        ------- ');
  21.  
  22. function DisplayStates: S2;
  23.  
  24. implementation
  25.  
  26. function DisplayStates;
  27. var I,
  28.     Row,
  29.     Col,
  30.     X:        integer;
  31.     AltAttr:  byte;
  32.     ScreenBuffer:   array [1..2000] of word;
  33.  
  34.   procedure GetState;
  35.   var Point,
  36.       OCh:            integer;
  37.       Ch:             char;
  38.       Continue,
  39.       FunctionKey:        boolean;
  40.       Str:             S2;
  41.   begin
  42.   Continue := true;
  43.   while Continue do
  44.     begin
  45.     Point := (Col-1) * 20 + 1;
  46.     FastWrite( copy(StateLine[Row],Point,19), Row, Point, AltAttr);
  47.     GetKey(Ch,FunctionKey);
  48.     FastWrite( copy(StateLine[Row],Point,19), Row, Point, Menus.Attr);
  49.     if FunctionKey then
  50.        begin
  51.        if (Ch = #75) and (Col > 1) then dec(Col);
  52.        if (Ch = #77) and (Col < 4) then inc(Col);
  53.        if (Ch = #72) and (Row > 1) then dec(Row);
  54.        if (Ch = #80) and (Row < StateTop) then inc(Row);
  55.        if Ch = #68 then
  56.           begin
  57.           Str := copy(StateLine[Row], Point, 2);
  58.           Continue := false;
  59.           end;
  60.        end
  61.       else
  62.        begin
  63.        if Ch = #27 then
  64.           begin
  65.           Str := '  ';
  66.           Continue := false;
  67.           end;
  68.        end;
  69.     end;
  70.     DisplayStates := Str;
  71.   end;
  72.  
  73. begin
  74. MoveFromScreen( mem[BaseOfScreen:0], ScreenBuffer, 2000);
  75. SetBG;
  76. clrscr;
  77. AltAttr := SetAttr( Menus.Blink, false, Menus.bg, Menus.fg);
  78. for I := 1 to StateTop do FastWrite(LPad(StateLine[I],80), I, 1, Menus.Attr);
  79. FastWrite( BlankLine, 24, 1, Menus.Attr);
  80. DrawSquare( 1, 23, 80, 25, Menus.Attr, true);
  81. FastWrite( '[ESC]', 24, 19, Menus.Attr);
  82. FastWrite( '= exit', 24, 25, (Menus.Attr xor $0008));
  83. FastWrite( '[F10]', 24, 34, Menus.Attr);
  84. FastWrite( '= select state', 24, 40, (Menus.Attr xor $0008));
  85. Row := 1; Col := 1;
  86. GetState;
  87. MoveToScreen( ScreenBuffer, mem[BaseOfScreen:0], 2000);
  88. end;
  89.  
  90. end.
  91. 
  92.