Jump to content
thoga31

[Snippet] Unit para criar menus com renderers

Recommended Posts

thoga31

Lembrei-me desta mini-framework criada pelo @pwseo para criar menus com possibilidade de modificar o seu aspecto.

Decidi então fazer aquilo que há muito andava para fazer: criar o rascunho daquela que seria uma classe que permite a criação destes menus.

A minha mini-framework diferencia-se da do @pwseo pelos seguintes aspectos:

  • Está implementada com OOP (Object Pascal);
  • O rendering é feito através de uma property da classe, a qual possui uma sintaxe e funcionamento específicos;
  • Permite organizar o menu por teclas;
  • Tem um código bem mais complexo e muito menos elegante :D

Os métodos públicos para manipular o menu:

  • Create - cria uma instância, ou seja, um menu. Argumento opcional - define se é Sorted ou não (default = não). Não é definitivo, pode-se alterar com a propriedade sorted a qualquer momento.
  • Destroy - destrói todos os recursos associados à instância.
  • Add - adiciona um novo item ao menu. Recebe, por ordem, 1) o texto associado, 2) a tecla a premir, 3) o Procedure a executar.
  • Show - mostra o menu no monitor. Se render não for uma String nula, o output terá rendering, caso contrário será simples. Argumento opcional: título. NB: não lida com erros associados a uma má definição do rendering!
  • GetChoice - espera pela opção do utilizador e devolve a tecla (caracter) correspondente. Argumento opcional: define se executa logo a Procedure (default = sim).
  • KEYS - propriedade read-only que possui uma colecção de todas as opções (teclas/caracteres) do menu.
  • sorted - propriedade que define se o menu é mostrado organizado por teclas (caracteres).
  • render - propriedade write-only que define o rendering do menu. Sintaxe:
    §        -> define uma nova linha
    #TITLE   -> indica que aqui se deve escrever o título
    #OPTION  -> indica que aqui se devem escrever as opções. Assim que isto aparece, TODAS as opções serão escritas. Isto implica que não há separadores entre cada opção!
    @CENTER  -> define que deve ser escrito centrado
    


    Um exemplo será dado mais à frente, e será explicado, com o output respectivo.

Aqui fica a minha classe:

(*                                   === UNIT THOGA31.PAS ===                                   *
* By: Igor Nunes, aka thoga31 @ Portugal-a-Programar                                           *
* Date: November 30th, 2013                                                                    *
* Description:                                                                                 *
*    This unit contains a useful class which allows to create menus very easily with rendering *)

{$mode objfpc}
unit UFancyMenu;

interface
uses crt, sysutils, strutils;

(* Some useful constants *)
const sys : record   // cannot be used to define other constants 
        KEY_ENTER : char;
        KEY_ESC : char;
        NEWLINE : ShortString;
     end = (KEY_ENTER:#13; KEY_ESC:#27; NEWLINE:#13+#10);

type TStrArr = array of string;  // used for renderers
    TMenu = class(TObject)  // Procedures and Functions described on their implementation
       private
           type TProc = procedure;  
                TOption = record
                   prompt : string;  // Text to write
                   key : char;       // Key that must be pressed for this option
                   action : TProc;   // Procedure associated with this option
                end;
                TKeysSet = set of char;
                TOptList = array of TOption;

           var VMenu : TOptList;        // contains all the options of the menu
               VMenuSorted : TOptList;  // a sorted version of the menu, by keys
               VKeys : TKeysSet;        // a set of all keys used in this menu
               VSorted : boolean;       // informs if this menu must be shown sorted
               VRender : string;        // defines the renderer of the menu
               VMaxLength : word;       // helps to calculate the size of the menu with renderer

           procedure Sort;

       public
           constructor Create(mysorted : boolean = false);

           procedure Add(myprompt : string; mykey : char; myproc : TProc);
           procedure Show(title : string = '');
           function GetChoice(performAction : boolean = true) : char;

           property KEYS : TKeysSet read VKeys;                   // Gets the set of keys
           property sorted : boolean read VSorted write VSorted;  // Defines if the menu must be shown sorted by keys
           property render : string write VRender;                // Defines the render of the menu - '' for no render. Errors by misuse not controlled!
    end;

function SplitAtChar(const S : string; const CH : char = ' ') : TStrArr;


implementation

function SplitAtChar(const S : string; const CH : char = ' ') : TStrArr;
(* Splits a string by a char, returning the substrings, without the char, in a dynamic array of strings. *)
var i : integer;
   t : string = '';
begin
   SetLength(SplitAtChar, 0);
   for i := 1 to length(S) do begin
       if (S[i] = CH) or (i = length(S)) then begin
           SetLength(SplitAtChar, length(SplitAtChar)+1);
           SplitAtChar[high(SplitAtChar)] := t + IfThen(i = length(S), s[i], '');
           t := '';
       end else begin
           t := t + s[i];
       end;
   end;
end;

constructor TMenu.Create(mysorted : boolean = false);
(* Initialize the variants of the class *)
begin
   inherited Create;
   SetLength(self.VMenu, 0);
   self.VKeys := [];
   self.VSorted := mysorted;
   self.VRender := '';
   self.VMaxLength := 0;
end;

procedure TMenu.Sort;
(* Sorts the menu by keys in a second variant, "VMenuSorted". *)
var temp : TOption;
   i, j : integer;
begin
   self.VMenuSorted := self.VMenu;
   for i := 0 to high(self.VMenuSorted)-1 do
       for j := i to high(self.VMenuSorted) do
           if self.VMenuSorted[i].key > self.VMenuSorted[j].key then begin
               temp := self.VMenuSorted[i];
               self.VMenuSorted[i] := self.VMenuSorted[j];
               self.VMenuSorted[j] := temp;
           end;
end;

procedure TMenu.Add(myprompt : string; mykey : char; myproc : TProc);
(* Add a new item to the menu. *)
begin
   SetLength(self.VMenu, length(self.VMenu)+1);
   with self.VMenu[high(self.VMenu)] do begin
       prompt := myprompt;
       if self.VMaxLength < length(myprompt) then
           self.VMaxLength := length(myprompt);
       key := mykey;
       Include(self.VKeys, mykey);
       action := myproc;
   end;
end;

procedure TMenu.Show(title : string = '');
(* Displays the menu with the renderer. *)
var menu_to_show : TOptList;
   option : TOption;
   renderer : TStrArr;
   r : string;
   i : integer;
   maxlen : word;
begin
   if self.VSorted then begin
       self.Sort;
       menu_to_show := self.VMenuSorted;
   end else
       menu_to_show := self.VMenu;

   if self.VRender <> '' then begin  // we have renderer
       // Gets the renderers:
       renderer := SplitAtChar(self.VRender, '§');

       // Recalculate the maximum length, given the renderer:
       maxlen := VMaxLength;
       if length(title) > maxlen then begin
           for r in renderer do
               if AnsiContainsText(r, '#TITLE') then begin
                   inc(maxlen, length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', '')));
                   break;
               end;
       end else begin
           for r in renderer do
               if AnsiContainsText(r, '#OPTION') then begin
                   inc(maxlen, length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', '')));
                   break;
               end;
       end;

       // displays the menu with the application of the renders:
       for r in renderer do begin
           if AnsiContainsText(r, '#TITLE') then
               writeln(AnsiReplaceText(AnsiReplaceText(r, '#TITLE', IfThen(AnsiContainsText(r, '@CENTER'), PadCenter(title, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', ''))), PadRight(title, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#TITLE', ''))))), '@CENTER', ''))
           else if AnsiContainsText(r, '#OPTION') then
               for option in menu_to_show do
                   writeln(AnsiReplaceText(AnsiReplaceText(r, '#OPTION', IfThen(AnsiContainsText(r, '@CENTER'), PadCenter(option.prompt, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', ''))), PadRight(option.prompt, maxlen-length(AnsiReplaceText(AnsiReplaceText(r, '@CENTER', ''), '#OPTION', ''))))), '@CENTER', ''))
           else begin
               write(r[1]);
               for i:=2 to maxlen-1 do
                   write(r[2]);
               writeln(r[3]);
           end;
       end;

   end else begin // we have no renderer... simple output
       if title <> '' then
           writeln(title);
       for option in menu_to_show do
           writeln(option.prompt);
   end;
end;

function TMenu.GetChoice(performAction : boolean = true) : char;
(* Waits for the user's option. *)
var option : TOption;
begin
   repeat
       GetChoice := upcase(ReadKey);
   until GetChoice in self.VKeys;

   if performAction then
       for option in self.VMenu do
           if GetChoice = option.key then begin
               if option.action <> nil then
                   option.action;
               break;
           end;
end;

end.

Exemplo de aplicação:

{$mode objfpc}
program apostas;
uses crt, sysutils, strutils, thoga31;

procedure Pause;
(* Pauses the program until ENTER is pressed *)
begin
   repeat
   until readkey = sys.KEY_ENTER;
end;

procedure Totoloto;
begin
   clrscr;
   writeln('TOTOLOTO');
   Pause;
   clrscr;
end;

procedure Euromillions;
begin
   clrscr;
   writeln('EUROMILLIONS');
   Pause;
   clrscr;
end;


const EXIT_OPTION = #27;
var main_menu : TMenu;

begin
   main_menu := TMenu.Create();
   with main_menu do begin
       Add('  1 > Totoloto', '1', @Totoloto);
       Add('  2 > Euromillions', '2', @Euromillions);
       Add('ESC > Exit', EXIT_OPTION, nil);
       render := '+-+§| #TITLE@CENTER |§+-+§| #OPTION |§+-+';
   end;

   repeat
       main_menu.Show('Choose an option:');
   until main_menu.GetChoice = EXIT_OPTION;

   main_menu.destroy;
end.

Output do menu com rendering:

+--------------------+
|  Choose an option: |
+--------------------+
|   1 > Totoloto     |
|   2 > Euromillions |
| ESC > Exit         |
+--------------------+

Explicação do rendering:

main_menu.render := '+-+§| #TITLE@CENTER |§+-+§| #OPTION |§+-+';

Será mais fácil ver isto separado por linhas (caracter §):

+-+
| #TITLE@CENTER |
+-+
| #OPTION |
+-+

O método Show vai analisar cada linha do render e executa uma série de acções conforme o seu conteúdo.

  • 1ª, 3ª e 5ª linhas, +-+: se não há #TITLE nem #OPTION, terá de ter obrigatoriamente 3 caracteres! Neste caso, o primeiro e o último são os caracteres das pontas, e o caracter do meio é repetido até ao comprimento máximo, definido pelo título e/ou pelo item do menu mais comprido.
  • 2ª linha, | #TITLE@CENTER |: entre #TITLE e @CENTER não deverá haver espaços nem outros caracteres. Neste caso #TITLE@CENTER é substituído pelo título do menu e centrado conforme o comprimento máximo, descrito no ponto anterior. Defini esta sintaxe pois lê-se mesmo "title at center".
  • 4ª linha, | #OPTION |: é substituído pelas opções todas, uma por linha. Não é possível criar separadores entre opções.

Usem e modifiquem a classe para ficar melhor.

O que acham? Reconheço que este não é dos meus melhores códigos, mas é um princípio ;)

Saudações pascalianas!

Edited by thoga31
  • Vote 2

Knowledge is free!

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.