Ferramentas de Usuário

Ferramentas de Site


dev_geral:pascal:units:framework_menus

Framework para criação de menus (Object Pascal)

in fórum P@P

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.

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 thoga31;
 
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 utilizaçã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.

Explicação do rendering

Output do menu com rendering:

+--------------------+
|  Choose an option: |
+--------------------+
|   1 > Totoloto     |
|   2 > Euromillions |
| ESC > Exit         |
+--------------------+
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.
dev_geral/pascal/units/framework_menus.txt · Última modificação em: 2018/05/14 21:37 (edição externa)