Word Cruncher for Draw Something

unit unitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls;

type
  TformMain = class(TForm)
    mmDictionary: TMemo;
    edCandidates: TEdit;
    btnCruncher: TButton;
    ProgressBar: TProgressBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    cmbLength: TComboBox;
    lblStatistic: TLabel;
    lbResult: TListBox;
    lblUrl: TLabel;
    procedure btnCruncherClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure lblUrlClick(Sender: TObject);
    procedure lbResultDblClick(Sender: TObject);
  private
    procedure ReassignCandidates(list: TStringList);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMain: TformMain;

implementation

uses ShellAPI;
{$R *.dfm}

procedure TformMain.btnCruncherClick(Sender: TObject);
var
  i: integer;
  word: String;
  finish: Boolean;
  j: integer;
  letter: String;
  list: TStringList;
  index: integer;
  maxWord: integer;
  found: Boolean;
  answerLength: integer;
begin
  if Length(edCandidates.Text) <> 12 then
  begin
    MessageDlg('Please put all 12 candidates of letter', mtError, [mbOK], 0);
    edCandidates.SetFocus;
  end
  else if cmbLength.Text = '' then
  begin
    MessageDlg('Please choose the length of the answer', mtError, [mbOK], 0);
    cmbLength.SetFocus;
  end
  else
  begin
    lbResult.Items.Clear;
    lblStatistic.Caption := '';
    i := 0;
    list := TStringList.Create;
    ProgressBar.Position := 0;
    maxWord := mmDictionary.Lines.Count;
    ProgressBar.Max := maxWord;
    answerLength := StrToIntDef(cmbLength.Text, 0);
    while (i < maxWord) do
    begin
      word := UpperCase(mmDictionary.Lines[i]);

      if Length(word) = answerLength then
      begin
        ReassignCandidates(list);

        j := 1;
        finish := false;
        found := true;
        while (Not finish) and (j <= answerLength) do
        begin
          letter := Copy(word, j, 1);
          index := list.IndexOf(letter);
          if index >= 0 then
          begin
            list.Delete(index);
            Inc(j);
          end
          else
          begin
            finish := true;
            found := false;
          end;
        end;

        if found then
        begin
          if lbResult.Items.IndexOf(word) = -1 then
            lbResult.Items.Add(word);
        end;

        Application.ProcessMessages;
      end;
      ProgressBar.StepBy(1);
      Inc(i);
    end;
    list.Free;

    if lbResult.Items.Count > 0 then
    begin
      lblStatistic.Caption := 'You got ' + VarToStr(lbResult.Items.Count)
        + ' possible answer(s) among ' + VarToStr(mmDictionary.Lines.Count)
        + ' English words in the dictionary';
    end
    else
    begin
      lblStatistic.Caption := 'No possible words found in the dictionary. ' +
        'It may not a valid English word such as celebrity names, movie titles, etc, ' + 'or it may a combination of more than one word such as bullseye, jumpball, etc';
    end;
  end;
end;

procedure TformMain.FormCreate(Sender: TObject);
var
  dictFile: string;
begin
  dictFile := ExtractFileDir(ParamStr(0)) + '\dictionary.txt';
  if FileExists(dictFile) then
    try
      mmDictionary.Lines.LoadFromFile(dictFile);
    except
      MessageDlg('Cannot load ' +
          'file ''dictionary.txt''. It may be corrupted. Please reinstall.',
        mtError, [mbOK], 0);
    end
  else
    MessageDlg('No dictionary found. Please ensure that ' +
        'file ''dictionary.txt'' is in the same folder with this application.',
      mtError, [mbOK], 0);
end;

procedure TformMain.lblUrlClick(Sender: TObject);
begin
  ShellExecute(0, 'open', PChar('iexplore.exe'), PChar(
      'http://wisnuwidiarta.wordpress.com/tag/drawsomething'), nil, SW_SHOW);
end;

procedure TformMain.lbResultDblClick(Sender: TObject);
var
  url: string;
begin
  if lbResult.ItemIndex <> -1 then
  begin
    url := 'http://dictionary.reference.com/browse/' + lbResult.Items
      [lbResult.ItemIndex];

    ShellExecute(0, 'open', PChar('iexplore.exe'), PChar(url), nil, SW_SHOW);
  end;
end;

procedure TformMain.ReassignCandidates(list: TStringList);
var
  i: integer;
  len: integer;
begin
  list.Clear;
  len := Length(edCandidates.Text);
  for i := 1 to len do
    list.Add(UpperCase(Copy(edCandidates.Text, i, 1)));
end;

end.