1692 - Generator Menu

Programowanie w Turbo Vision ma to do siebie, że przy każdym, nawet małym, próbnym programie należy zdefiniować typ, a w nim zadeklarować procedury. Są to przeważnie: HandleEvent, InitMenuBar i InitStatusLine. Cała struktura programu jest niewątpliwie rzeczą pozytywną, jednak zniechęca młodych "praktyków" programistów, którzy rozwijają swoje zdolności bardziej kreatywnie (tzn. nie stosują przykładów z książki, lecz sami chcą wypróbować działanie danej procedury lub przydatność danego typu).

Im to właśnie przede wszystkim, ale i pozostałym "praktykom" również, chciałbym przedstawić program, dzięki któremu w prosty sposób można tworzyć menu i ewentualnie zapisywać jego stan w pliku z zasobami.

W programie wykorzystałem moduły Editors i Buffers, dzięki którym plik można poddawać edycji z zapisem Menu. Plik taki można wcześniej utworzyć np. w edytorze Turbo Pascal-a. Może on wyglądać na przykład tak, jak na wydruku 2.

Składnia pliku podlega następującym zasadom : Po nazwie każdego elementu menu występuje jeden ze znaków: "(" , ")", bądź "," ,przy czym ilość nawiasów otwartych i zamkniętych powinna być taka sama. Należy dodać jeszcze jedno: bezpośrednio po sobie mogą występować tylko znaki ")". Po zamknięciu nawiasu, następnego elementu nie oddziela się przecinkiem. Przykładową składnię podaję na wydruku 2.

W programie tym kompilacja do postaci Menu dokonywana jest przez pobranie danych z dysku twardego. Aby dane były pobierane z bufora, należy dokonać odpowiednich zmian w procedurze ReadWord.

Program ten staje się praktycznie użyteczny przez dodanie procedury PrintHandle. Zadaniem tej procedury jest drukowanie numerów komend i numerów kontekstu helpu skojarzonych z danym elementom Menu. Procedurę tę można łatwo skorygować, jeśli owe numery powinny być wypisywane na ekranie.

Na koniec chciałbym jeszcze dodać, że jeśli ktoś chce, aby każdy element Menu miał dokładnie różny numer kontekstu helpu, należy dodać w funkcji nowemenu po instrukcji Inc(CommandCounter) instrukcję Inc(HelpCounter).

Program GeneratorMenu; { autor: Tomasz Siwak, Poznań, Czerwiec 1992 }
{$M 8192,8192,655360}
{$X+,S-}

Uses Dos, Printer, Objects, Drivers, Memory, Views, Menus, Dialogs, App, Buffers, Editors;

Const
  HeapSize = 32*(1024 Div 16);
  cmOpen   = 100;
  cmGo     = 101;
  cmReady  = 102;
  cmOut    = 103;
  cmPrint  = 104;
  Out : Boolean = False;
  Am : pMenu = Nil;

Type
  pEditorApp = ^tEditorApp;
  tEditorApp = Object(tApplication)
    Constructor Init;
    Destructor Done;  Virtual;
    Procedure HandleEvent(Var Event: tEvent);  Virtual;
    Procedure InitMenuBar;  Virtual;
    Procedure InitStatusLine;  Virtual;
  End;

Var
  EditorApp : tEditorApp;
  ClipWindow : pEditWindow;
  PP : pView;
  HelpCounter, CommCounter : Word;
  PM : pMenuItem;
  Zbior : File;

  Function OpenEditor(FileName: pNameStr; Visible: Boolean): pEditWindow;
  Var P : pView;
       R : tRect;
  Begin
    DeskTop^.GetExtent(R);
    R.Assign(5,5,75,20);
    P := Application^.ValidView(New(pEditWindow,Init(R,FileName,wnNoNumber)));
    If Not Visible Then P^.Hide;
    DeskTop^.Insert(P);
    PP := P;
    OpenEditor := pEditWindow(P);
  End;

  Constructor tEditorApp.Init;
  Var Ch : pEditBuffer;
       H : Word;
       R : tRect;
  Begin
    H := PtrRec(HeapEnd).Seg-PtrRec(HeapPtr).Seg;
    If H > HeapSize Then BufHeapSize := H-HeapSize Else BufHeapSize := 0;
    InitBuffers;
    tApplication.Init;
    ClipWindow := OpenEditor('',False);
    If ClipWindow <> Nil Then
    Begin
      ClipBoard := ClipWindow^.Editor;
      ClipBoard^.CanUndo := False;
    End;
  End;

  Destructor tEditorApp.Done;
  Begin
    tApplication.Done;
    DoneBuffers;
  End;
  {-}
  Procedure ReadWord(Var pdol: String; Var zdol: Byte);
  Var B: Byte;
       YE: Boolean;
  Begin
    pdol := ''; zdol := 32;
    If Eof(Zbior) Then Exit;
    Repeat
      BlockRead(Zbior,b,1); YE := False;
      If (B>31) And (B<>40) And (B<>41) And (B<>44) Then YE := True;
      If YE Then pdol := pdol+Chr(B);
    Until (Not(YE) And (B>31)) Or Eof(zbior);
    zdol := B;
  End;
  {-}
  Function NoweMenu: pMenuItem;
  Var pDol: String;
       zDol: Byte;
  Begin
    ReadWord(pDol,zDol);
    If (pDol<>'') And (zDol=41) Then zDol := 0;
    Case zDol Of
      40: Begin
        Inc(HelpCounter);
        NoweMenu := NewSubMenu(pDol,HelpCounter,NewMenu(NoweMenu),NoweMenu)
      End;
      {-}
      44: Begin
        Inc(CommCounter);
        NoweMenu := NewItem(pDol,'',0,CommCounter,HelpCounter,NoweMenu)
      End;
      {-}
      00: Begin
        Inc(CommCounter);
        NoweMenu := NewItem(pDol,'',0,CommCounter,HelpCounter,Nil)
      End Else NoweMenu := Nil;
    End;
  End;
  {-}
  Procedure tEditorApp.HandleEvent(Var Event: tEvent);
    {-}
    Procedure FileOpen;
    Begin
      OpenEditor('APPLICAT.MNU',True);
    End;
    {-}
    Procedure PrintHandle;
    Var PM: pMenuItem;
         OM: Array[1..10] Of pMenuItem;
    Const Lev: 0..10 = 0;
    Begin
      PM := MenuBar^.Menu^.Items;
      If PM <> Nil Then
      While True=True Do
      Begin
        WriteLn(lst,PM^.Name^,'....',PM^.Command,',',PM^.HelpCtx);
        IF PM^.Command = 0 Then
        Begin
          Inc(Lev);
          OM[Lev] := PM;
          PM := PM^.SubMenu^.Items;
        End Else If PM^.Next = Nil Then
        Begin
          PM := OM[Lev]^.Next;
          Dec(Lev);
          While (Lev > 0) And (PM = Nil) Do
          Begin
            PM := OM[Lev]^.Next;
            Dec(Lev);
          End;
          If (PM = Nil) And (Lev < 1) Then Exit
        End Else PM^.Next;
      End
    End;
    {-}
    Procedure CompileToMenu;
    Begin
      Dispose(PP,Done);
      HelpCounter := 1000;
      CommCounter := 1000;
      Asign(Zbior,'APPLICAT.MNU');
      Reste(Zbior,1);
      Seek(Zbior,0);
      AM := NewMenu(NoweMenu);
      Close(Zbior);
      Event.What := evCommand;
      Event.Command := cmQuit;
      PutEvent(Event);
    End;
    {-}
  Begin
    tApplication.HandleEvent(Event);
    Case Event.What Of
      evCommand: Case Event.Command Of
        cmOpen  : FileOpen;
        cmReady : CompileToMenu;
        cmOut   : Begin
          Out := True;
          Event.What := evCommand;
          Event.Command := cmQuit;
          PutEvent(Event);
        End;
        cmPrint : PrintHandle;
        Else Exit;
      End; Else Exit;
    End;
    ClearEvent(Event);
  End;
  {-}
  Procedure tEditorApp.InitMenuBar;
  Var R: tRect;
  Begin
    GetExtent(R);
    R.B.Y := R.A.Y + 1;
    MenuBar := New(pMenuBar,Init(R,AM));
  End;
  {-}
  Procedure tEditorApp.InitStatusLine;
  Var R: tRect;
  Begin
    GetExtent(R);
    R.A.Y := R.B.Y - 1;
    New(StatusLine,Init(R,
      NewStatusDef(0, $ffff,
        NewStatusKey('-F3- Open menu file', kbF3, cmOpen,
        NewStstusKey('-F2- Save', kbF2, cmSave,
        NewStatusKey('-F9- Compile And Execute', kbF9, cmReady,
        NewStatusKey('-F10- Print', kbF10, cmPrint,
        NewStstusKey('-Alt-X- Quit', kbAltX, cmQuit, Nil))))),
      Nil))
    );
  End;
  {-}
Begin
  Repeat
    EditorApp.Init;
    EditorApp.Run;
    EditorApp.Done;
  Until Out
End.
{ Przykład prostego menu: }

  File(Open,New,Save)
  Debug(Evaluate, Watches(Add watch..., Delete, Edit watch)Toogle)
  Options(Exit,Shell)

Tomasz Siwak - PCKurier 16/1992r.