Ferramentas de Usuário

Ferramentas de Site


dev_geral:pascal:units:fw_menus

Mini-Framework para fazer programas com menus

O objectivo inicial era utilizar objectos (obviamente), mas como estava a pensar direccionar isto para os iniciados, abandonei essa ideia (são muitos conceitos novos) e optei por utilizar uma abordagem procedural semi-orientada a objectos.

Através da utilização de callbacks (conceito muuuito à frente :p) o menu pode ser facilmente personalizado, basta definir procedimentos que "façam o render" do título e de cada opção (ou seja, existe efectivamente uma separação do conteúdo e da aparência).

O facto de cada item saber qual o procedimento que lhe corresponde obriga à boa prática de separar os programas em fragmentos mais facilmente compreendidos e estruturados. O único senão aqui é ter que dizer aos novatos que precisam de colocar um @ antes do nome do procedimento (tem a ver com pointers).

No entanto, nunca mais toquei nisto xD De qualquer forma, aqui fica o código, caso alguém queira dar-lhe continuidade. Também estou aberto a sugestões, nunca se sabe quando voltarei a pegar nisto :) Talvez um dia mova tudo para o github

Módulo

Aqui fica o módulo da framework: http://pastebin.com/KszMyBev

{$MODE OBJFPC}
unit PasMenu;
 
interface
 
type
  TMenuAction = procedure;
  TTitleRenderer = procedure(t: string);
  TItemRenderer  = procedure(t: string; i: integer);
  TMenuEntry = record
    title: string;
    proc:  TMenuAction;
  end;
  TMenu = record
    title: string;
    items: array of TMenuEntry;
    internal: record
      TitleRenderer: TTitleRenderer;
      ItemRenderer:  TItemRenderer;
    end;
  end;
 
procedure MenuSetup(var menu: TMenu; title: string);
procedure MenuRender(var m: TMenu);
procedure MenuChoose(var m: TMenu);
procedure MenuAddItem(var m: TMenu; title: string; action: TMenuAction);
procedure MenuSetTitleRenderer(var m: TMenu; renderer: TTitleRenderer);
procedure MenuSetItemRenderer(var m: TMenu; renderer: TItemRenderer);
 
implementation
 
procedure MenuRenderTitle(title: string);
begin
  WriteLn(title);
end;
 
procedure MenuChoose(var m: TMenu);
var
  s: string;
  e, i: integer;
begin
  repeat
    write('> ');
    readln(s);
    val(s, i, e);
  until (e <= 0) and (i >= 0);
  if (i <> 0) then
    m.items[pred(i)].proc();
end;
 
procedure MenuAddItem(var m: TMenu; title: string; action: TMenuAction);
begin
  setlength(m.items, succ(length(m.items)));
  m.items[pred(length(m.items))].title := title;
  m.items[pred(length(m.items))].proc  := action;
end;
 
procedure MenuRenderItem(title: string; number: integer);
begin
  WriteLn(number, '. ', title);
end;
 
procedure MenuRender(var m: TMenu);
var
  i: integer;
begin
  m.internal.TitleRenderer(m.title);
  for i := 0 to pred(length(m.items)) do
    m.internal.ItemRenderer(m.items[i].title, succ(i));
end;
 
procedure MenuSetup(var menu: TMenu; title: string);
begin
  menu.title := title;
  menu.internal.TitleRenderer := @MenuRenderTitle;
  menu.internal.ItemRenderer  := @MenuRenderItem;
end;
 
procedure MenuSetTitleRenderer(var m: TMenu; renderer: TTitleRenderer);
begin
  if renderer = nil then
    m.internal.TitleRenderer := @MenuRenderTitle
  else
    m.internal.TitleRenderer := renderer;
end;
 
procedure MenuSetItemRenderer(var m: TMenu; renderer: TItemRenderer);
begin
  if renderer = nil then
    m.internal.ItemRenderer := @MenuRenderItem
  else
    m.internal.ItemRenderer := renderer;
end;
 
end.

Utilização

E já agora, um exemplo da sua utilização:

{$MODE OBJFPC}
program test;
 
uses
  SysUtils, PasMenu;
 
procedure Foo;
begin
  writeln('foo');
end;
 
procedure Bar;
begin
  writeln('bar');
end;
 
var
  m: TMenu;
begin
  MenuSetup(m, 'This is a menu');
  MenuAddItem(m, 'Foo', @Foo);
  MenuAddItem(m, 'Bar', @Bar);
  MenuRender(m);
  MenuChoose(m);
end.

E aqui um exemplo que faz uso dos tais callbacks para mudar o aspecto do menu:

{$MODE OBJFPC}
program test;
 
uses
  SysUtils, PasMenu;
 
procedure Foo;
begin
  writeln('foo');
end;
 
procedure Bar;
begin
  writeln('bar');
end;
 
procedure myrenderer(t: string; i: integer);
var
  s, d: string;
  j: integer;
begin
  s := inttostr(i);
  d := '';
  for j := 1 to length(s) do
    d := d + '-';
  writeln('');
  writeln('+-', d, '-+');
  writeln('| ', i, ' |  ', t);
  writeln('+-', d, '-+');
end;
 
procedure mytitle(t: string);
var
  i: integer;
  s: string;
begin
  s := '';
  for i := 1 to length(t) do
    s := s + '*';
  writeln('**', s, '**');
  writeln('* ', t, ' *');
  writeln('**', s, '**');
end;
 
var
  m: TMenu;
begin
  MenuSetup(m, 'This is a menu');
  MenuAddItem(m, 'Foo', @Foo);
  MenuAddItem(m, 'Bar', @Bar);
  MenuSetTitleRenderer(m, @mytitle);
  MenuSetItemRenderer(m, @myrenderer);
  MenuRender(m);
 
  // back to the default renderers
  MenuSetTitleRenderer(m, nil);
  MenuSetItemRenderer(m, nil);
  writeln;
  MenuRender(m);
  MenuChoose(m);
end.
dev_geral/pascal/units/fw_menus.txt · Última modificação em: 2018/05/14 21:37 (edição externa)