[samsagaz]

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
    { Public declarations }
  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
  { Por cada KeySet }
  for i := 1 to 4 do begin
    { Por cada caracter en KeySet }
    for j := 1 to Length(Keys[i]) do begin
      { Si el caracter iguala al de AWord[Pos] }
      if AWord[Pos] = Keys[i][j] then begin
        { Mirar un Keyset hacia arriba y uno hacia abajo }
        for x := i-1 to i+1 do begin
          { Y también un caracter a la izquierda y a la derecha }
          for y := j-1 to j+1 do begin
            { Si la posición es incorrecta, o igual a la del caracter actual o es un #0 en keyset -> saltaeralo }
            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;
            { Sino, escribir la palabra alternativa }
            NewWord := AWord;
            NewWord[Pos] := Keys[x][y];
            Memo1.Lines.Add(NewWord);
          end;
        end;
        Exit;        
      end;
    end;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
  { Caracteres #0 son saltados }
  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
    { Recorrer string por palabras }
    while AWordPtr <> nil do begin
      Ptr := StrScan(AWordPtr, ' ');
      if Ptr <> nil then
        Ptr^ := #0;
      { Recorrer cada letra de cada palabra }
      Memo1.Lines.Add('----- Alternativas de ' + AWordPtr + ' -----');
      for i := 1 to Length(AWordPtr) do begin
        if AWordPtr[i] = ' ' then
          Continue;
        { Buscar alternativas }
        FindWords(Keys,AWordPtr,i);
        Memo1.Lines.Add('');
      end;
      { Apuntar a la siguiente palabra en el string }
      if Ptr <> nil then begin
        Ptr^ := ' ';
        Inc (Ptr);
      end;
      AWordPtr := Ptr;
    end;
    { Hacer Scroll en el memo a la primera línea }
    Memo1.SelStart := 0;
    Memo1.SelLength := 1;
  finally
    Memo1.Lines.EndUpdate;
  end;
end;
end.

Gracias a Anibal por el código.