Framework para criação de menus (Object Pascal)
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.