Power-Programmierung/CD1.mdf/pascal/library/dos/tp6goodi/toggle/screen.pas

Pascal/Delphi Source File | 1991-01-31 | 8.3 KB | 285 lines

unit Screen;

interface

  uses
    Crt, Dos, Objects, Drivers, Views, Menus, Dialogs, App,
    Help_Cmd;

  type
    PToggleKeysView = ^TToggleKeysView;
    TToggleKeysView = object(TView)
      OldStatusWord : Word;
      constructor Init(var Bounds: TRect);
      procedure Draw; virtual;
      procedure Update;
    end;

  procedure CheckIfKeyPressed( CurrentHelpCtx : word );

implementation

const
  coNoObject   = 0;
  coDeskTop    = 1;
  coDialog     = 2;
  coMenuBar    = 3;
  coEditWindow = 4;

var
  KbdStatusWord : Word absolute $0040:$0017;
  AltPressed : boolean;
  CtrlPressed : boolean;
  ShiftPressed : boolean;
  SecCnt : byte;
  OldHelpCtx : word;
  OldSec, NewSec : byte;
  CurrentObjectType : byte;

   {------ ToggleKeys Window object ----------}

  constructor TToggleKeysView.Init(var Bounds: TRect);
  begin
    TView.Init(Bounds);
    OldStatusWord := 0;
  end;

  procedure TToggleKeysView.Draw;
  var
    S: String[16];
    B: TDrawBuffer;
    C: Byte;
  begin
    OldStatusWord := KbdStatusWord;

    { KBDStatusWord at $0040:$0017
      $80 : Ins Active
      $40 : Caps Lock Active
      $20 : Num Lock Active
      $10 : Scroll Lock Active
      $08 : Alt Depressed
      $04 : Ctrl Depressed
      $02 : Left Shift Depressed
      $01 : Right Shift Depressed
    }
      C := GetColor(2);
      S := '                ';
      if (OldStatusWord and $40) <> 0 then
        begin
          S[ 2 ] := 'C';
          S[ 3 ] := 'A';
          S[ 4 ] := 'P';
          S[ 5 ] := 'S';
        end;
      if (OldStatusWord and $20) <> 0 then
        begin
          S[ 7 ] := 'N';
          S[ 8 ] := 'U';
          S[ 9 ] := 'M';
        end;
      if (OldStatusWord and $10) <> 0 then
        begin
          S[ 11 ] := 'S';
          S[ 12 ] := 'C';
          S[ 13 ] := 'R';
          S[ 14 ] := 'O';
          S[ 15 ] := 'L';
          S[ 16 ] := 'L';
        end;
    MoveChar(B, ' ', C, 15);
    MoveStr(B, S, C);
    WriteLine(0, 0, Size.X, 1, B);
  end;

  procedure TToggleKeysView.Update;
  begin
    if (OldStatusWord <> KbdStatusWord) then DrawView;
  end;

  procedure CheckIfKeyPressed( CurrentHelpCtx : word );

    { KBDStatusWord at $0040:$0017
    $80 : Ins Active
    $40 : Caps Lock Active
    $20 : Num Lock Active
    $10 : Scroll Lock Active
    $08 : Alt Depressed
    $04 : Ctrl Depressed
    $02 : Left Shift Depressed
    $01 : Right Shift Depressed
  }

    const
      ShiftKeyMask = 3;
      CtrlKeyMask = 4;
      AltKeyMask = 8;

    var
      h,m,s,hund: word;
      CurrentMenuItem : PMenuItem;

      function KeyReleased( TheKeyMask : byte ) : boolean;

        var
          KbdFlagInfo : word;

        begin { KeyReleased }
          KbdFlagInfo := KbdStatusWord;
          KeyReleased := False;
          if ( KbdFlagInfo and TheKeyMask ) = 0 then
            KeyReleased := True;
        end; { KeyReleased }

      function FindHelpCtx(AMenu: PMenu; Ctx: word): PMenuItem;

        { Copyright (c) 1990 by Danny Thorpe                           }

        var P,Q: PMenuItem;
        begin { FindHelpCtx }
          P := AMenu^.Items;
          while P <> nil do
            begin
            if (P^.HelpCtx = Ctx) and not P^.Disabled then
                begin
                FindHelpCtx := P;
                Exit;
                end
            else
            if (P^.Command = 0) and (P^.Name <> nil) then
              begin
              Q := FindHelpCtx(P^.SubMenu, Ctx);
              if Q <> nil then
                begin
                FindHelpCtx := Q;
                Exit;
                end;
              end;
            P := P^.Next;
            end;
          FindHelpCtx := nil;
        end; { FindHelpCtx }

      procedure ResetFlagsAndHelpCtx( var OldHelpCtx  : word;
                                          KeysHelpCtx : word );

        begin { ResetFlagsAndHelpCtx }
          SecCnt := 0;
          ShiftPressed := False;
          CtrlPressed := False;
          AltPressed := False;
        { Restore the help context.  Be sure you have the right type. }
          case CurrentObjectType of
            coNoObject : ;
            coDeskTop  : DeskTop^.HelpCtx := OldHelpCtx;
            coDialog   : PDialog( DeskTop^.Current )^.HelpCtx := OldHelpCtx;
            coMenuBar  :
              begin
              { Submenu pulled down }
                CurrentMenuItem :=
                  FindHelpCtx( MenuBar^.Menu, KeysHelpCtx );
              { Submenu not pulled down }
                if CurrentMenuItem <> nil then
                  CurrentMenuItem^.HelpCtx := OldHelpCtx;
              end;
            {coEditWindow : PEditWindow( DeskTop^.Current )^.HelpCtx := OldHelpCtx;}
          end; { case }
        end; { ResetFlagsAndHelpCtx }

    procedure ChangeHelpCtx( var OldHelpCtx, CurrentHelpCtx : word;
                                 NewStatusCtx : word );

      begin { ChangeHelpCtx }
        if DeskTop^.Current = nil then
          begin
          { No dialogs or editor windows open }
            OldHelpCtx := CurrentHelpCtx;
            if MenuBar^.Current <> nil then
              begin
              { Submenu pulled down }
                CurrentMenuItem :=
                  FindHelpCtx( MenuBar^.Menu, OldHelpCtx );
                CurrentMenuItem^.HelpCtx := NewStatusCtx;
                CurrentObjectType := coMenuBar;
              end
            else
              begin
                { Not in the menu }
                DeskTop^.HelpCtx := NewStatusCtx;
                CurrentObjectType := coDeskTop;
              end;
          end
        else
        { Use the TypeOf funxtion to determine what kind of window is open }
          if typeof( DeskTop^.Current^ ) = typeof( TDialog ) then
            begin
              OldHelpCtx := PDialog( DeskTop^.Current )^.HelpCtx;
              PDialog( DeskTop^.Current )^.HelpCtx := NewStatusCtx;
              CurrentObjectType := coDialog;
            end
          else
          {if typeof( DeskTop^.Current^ ) = typeof( TEditWindow ) then
            begin
              OldHelpCtx := PEditWindow( DeskTop^.Current )^.HelpCtx;
              PEditWindow( DeskTop^.Current )^.HelpCtx := NewStatusCtx;
              CurrentObjectType := coEditWindow;
            end;}
      end; { ChangeHelpCtx }

    begin { CheckIfKeyPressed }

    { Check if the key was pressed and is now released. }
      if KeyReleased( AltKeyMask ) and AltPressed then
        ResetFlagsAndHelpCtx( OldHelpCtx, hcAltKeys )
      else
        if KeyReleased( CtrlKeyMask ) and CtrlPressed then
          ResetFlagsAndHelpCtx( OldHelpCtx, hcCtrlKeys )
        else
          if KeyReleased( ShiftKeyMask ) and ShiftPressed then
            ResetFlagsAndHelpCtx( OldHelpCtx, hcShiftKeys );

    { Check if a second has passed }
      GetTime(h,m,s,hund);
      NewSec := s;
      if NewSec <> OldSec then
        begin
        { A second has passed, so check for a pressed key,
          if the key is pressed increment the counter and set flag. }
          if not KeyReleased( ShiftKeyMask ) then
            begin
              inc( SecCnt );
              ShiftPressed := True
            end
          else
            if not KeyReleased( CtrlKeyMask ) then
              begin
                inc( SecCnt );
                CtrlPressed := True
              end
            else
              if not KeyReleased( AltKeyMask ) then
                begin
                  inc( SecCnt );
                  AltPressed := True
                end;
        { if counter reaches its limit change the help context }
          if SecCnt = 2 then
            begin
              if ShiftPressed then
                ChangeHelpCtx( OldHelpCtx, CurrentHelpCtx, hcShiftKeys )
              else
                if CtrlPressed then
                  ChangeHelpCtx( OldHelpCtx, CurrentHelpCtx, hcCtrlKeys )
                else
                  if AltPressed then
                    ChangeHelpCtx( OldHelpCtx, CurrentHelpCtx, hcAltKeys );
            end;
          OldSec := NewSec;
        end;
    end; { CheckIfKeyPressed }

begin
  OldHelpCtx := hcNoContext;
  CurrentObjectType := coNoObject;
  NewSec := 0;
  OldSec := 0;
end.