Saludos a todos los de Delphi Acces, por primera vez publicaré una utilería desarrolada en Delphi para recorrer un TMainMenu, darle numeración continua a los items que no tienen dependencias, darle formato a los nombres de los menús según la convención de Camel (Utilice para ello funciones como Split (Java) para tokenizar mi cadena), quitar los acentos y caracteres como la ñ a dichos nombres y por último el contenido de todos los items del TMenu serán mostrados en una Tlist.
A continuación publico mi código fuente empleado.
[Delphi]
unit AnalizaMenus;
interface
uses
SysUtils, Variants, Classes,Menus,StdCtrls,
Windows, Messages, Graphics, Controls, Forms, Dialogs, ShlObj, ActiveX, FileCtrl,ComObj;
type
AnalizaMenu = class
private
lisBox:^TListBox;
menuPrincipal:^TMainMenu;
nivelTabulador:integer;
numerador:integer;
tokens: TStringList;
public
constructor create;overload;
constructor create(lista:pointer;menu:pointer);overload;
procedure recorreMenuPrincipal;
function tieneHijosItem(menuItem:TMenuItem):integer;
function tabuludorNivel(nivel:integer):string;
procedure getItems(menuItem:TMenuItem;nivel:integer);
procedure split(const Delimiter: Char;Input: string;const Strings: TStrings) ;
function capitalizarMayuscula(cadenaOriginal: string): string;
function capitalizarMinuscula(cadenaOriginal: string): string;
function extractSimbolFromMultiByteChar(Text: PAnsiChar): Char;
end;
implementation
uses TiposDeDatos;
{ AnalizaMenu }
constructor AnalizaMenu.Create;
begin
end;
constructor AnalizaMenu.create(lista: pointer;menu:pointer);
begin
self.lisBox:=lista;
self.menuPrincipal:=menu;
self.nivelTabulador:=0;
self.numerador:=0;
end;
procedure AnalizaMenu.getItems(menuItem: TMenuItem; nivel: integer);
var
in:Integer;
x:integer;
token:string;
enNivel:string;
str:wstring;
begin
for in := 0 to (menuItem.Count - 1) do
begin
enNivel:=tabuludorNivel(nivel);
Str := menuItem.Items[in].Caption;
str:=str.replace('&','');
//------------------------
tokens.Clear;
split(' ', str , tokens) ;
str:='';
for x := 0 to tokens.Count-1 do
begin
token:= token;
if x=0 then
str:= str+ capitalizarMinuscula(token)
else
str:=str+capitalizarMayuscula(token);
end;
//------------------------
if str<>'-' then
begin
numerador:=numerador+1;
if tieneHijosItem(menuItem.items)>0 then
begin
lisBox.Items.AddObject(enNivel+ Str, menuItem.Items);
GetItems(menuItem.items,nivel+1);
end
else
lisBox.Items.AddObject(enNivel+ inttostr(numerador)+'.-'+Str, menuItem.Items);
end;
end;
end;
procedure AnalizaMenu.recorreMenuPrincipal;
var
x:integer;
i:integer;
str:wstring;
token:string;
begin
tokens := TStringList.Create;
for i := 0 to (menuPrincipal.Items.Count - 1) do
begin
numerador:=numerador+1;
str := menuPrincipal.Items.Caption;
str:=str.replace('&','');
//------------------------
tokens.Clear;
split(' ', str , tokens) ;
str:='';
for x := 0 to tokens.Count-1 do
begin
token:= tokens[/i];
if x=0 then
str:= str+ capitalizarMinuscula(token)
else
str:=str+capitalizarMayuscula(token);
end;
//------------------------
lisBox.Items.AddObject(str, menuPrincipal.items);
//Verificamos si contiene hijos
if tieneHijosItem(menuPrincipal.items)>0 then
GetItems(menuPrincipal.items,nivelTabulador+1);
end;
lisBox.Items.SaveToFile('C:/mismenus.txt');
end;
function AnalizaMenu.tabuludorNivel(nivel: integer): string;
var
i:integer;
begin
result:='';
for i := 0 to nivel - 1 do
result:=result+' ';
end;
function AnalizaMenu.tieneHijosItem(menuItem: TMenuItem): integer;
var
i:Integer;
begin
result:=menuItem.Count - 1;
end;
procedure AnalizaMenu.split(const Delimiter: Char;Input: string;const Strings: TStrings) ;
begin
Assert(Assigned(Strings)) ;
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
function AnalizaMenu.capitalizarMayuscula(cadenaOriginal: string): string;
var
s: string;
i: integer;
b: boolean;
cadena:string;
begin
cadena:='';
for i := 1 to Length(cadenaOriginal) do
cadena:=cadena+extractSimbolFromMultiByteChar(PAnsiChar(AnsiString(cadenaOriginal)));
s := '';
b := true;
for i := 1 to Length(cadena) do
begin
if b then
s := s + AnsiUpperCase(cadena)
else
s := s + cadena;
b := (cadena = ' ');
end;
Result := s;
end;
function AnalizaMenu.capitalizarMinuscula(cadenaOriginal: string): string;
var
s: string;
i: integer;
b: boolean;
cadena:string;
begin
cadena:='';
for i := 1 to Length(cadenaOriginal) do
cadena:=cadena+extractSimbolFromMultiByteChar(PAnsiChar(AnsiString(cadenaOriginal)));
s := '';
b := true;
for i := 1 to Length(cadena) do
begin
if b then
s := s + AnsiLowerCase(cadena)
else
s := s + cadena;
b := (cadena = ' ');
end;
Result := s;
end;
function AnalizaMenu.extractSimbolFromMultiByteChar(Text: PAnsiChar): Char;
var
Buffer: Char;
Size: Integer;
begin
Size := MultiByteToWideChar(0,0,Text,-1,nil,0);
if (Size > 0) then
begin
MultiByteToWideChar(0 ,MB_COMPOSITE , Text,-1, @Buffer, Size);
result:=Buffer;
end;
end;
end.
[/Delphi]
La manera para instanciarla esta clase pasandole como parametros el tLIST, y el Menu arecorrer:
[Delphi]
aaa:AnalizaMenu;
ListBox1.Items.Clear;
aaa:=AnalizaMenu.create(@ListBox1,@fmUflujo.Menu);
aaa.recorreMenuPrincipal;
freeandnil(aaa);
[/code]

Recorrer un TMainMenu en Delphi y mostarlo en forma de Arbol
Comenzado por
angelholberg
, jul 01 2011 12:53
1 respuesta en este tema