Un amigo me ha ayudado, les mustro el codigo, puede q alguien lo necesite
Código Delphi
[-]
type
TKeySet = Array[1..4] of Array[1..10] of Char;
TForm1 = class(TForm)
Edit1: TEdit;
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
protected
procedure FindWords(const Keys: TKeySet; AWord: String; Pos: Integer);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FindWords(const Keys: TKeySet; AWord: string; Pos: Integer);
var
i,j: Integer;
x,y: Integer;
NewWord: String;
begin
for i := 1 to 4 do begin
for j := 1 to Length(Keys[i]) do begin
if AWord[Pos] = Keys[i][j] then begin
for x := i-1 to i+1 do begin
for y := j-1 to j+1 do begin
if (x < 1) or (x > 4) or (y < 1) or (y > 10) or (Keys[x][y] = #0) or ((x = i) and (y = j)) then
Continue;
NewWord := AWord;
NewWord[Pos] := Keys[x][y];
Memo1.Lines.Add(NewWord);
end;
end;
Exit;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
Keys: TKeySet = (('1','2','3','4','5','6','7','8','9','0'),
('q','w','e','r','t','y','u','i','o','p'),
('a','s','d','f','g','h','j','k','l', #0),
('z','x','c','v','b','n','m', #0, #0, #0));
var
i,j: Integer;
AChar: Char;
AWordPtr: PChar;
Ptr: PChar;
begin
AWordPtr := PChar(LowerCase(Edit1.Text));
try
while AWordPtr <> nil do begin
Ptr := StrScan(AWordPtr, ' ');
if Ptr <> nil then
Ptr^ := #0;
Memo1.Lines.Add('----- Alternativas de ' + AWordPtr + ' -----');
for i := 1 to Length(AWordPtr) do begin
if AWordPtr[i] = ' ' then
Continue;
FindWords(Keys,AWordPtr,i);
Memo1.Lines.Add('');
end;
if Ptr <> nil then begin
Ptr^ := ' ';
Inc (Ptr);
end;
AWordPtr := Ptr;
end;
Memo1.SelStart := 0;
Memo1.SelLength := 1;
finally
Memo1.Lines.EndUpdate;
end;
end;
end.
Gracias a Anibal por el código.