SHARE
TWEET

Word Cruncher for Draw Something

WISNUWIDIARTA Apr 15th, 2012 97 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit unitMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ComCtrls, ExtCtrls;
  8.  
  9. type
  10.   TformMain = class(TForm)
  11.     mmDictionary: TMemo;
  12.     edCandidates: TEdit;
  13.     btnCruncher: TButton;
  14.     ProgressBar: TProgressBar;
  15.     Label1: TLabel;
  16.     Label2: TLabel;
  17.     Label3: TLabel;
  18.     Label4: TLabel;
  19.     cmbLength: TComboBox;
  20.     lblStatistic: TLabel;
  21.     lbResult: TListBox;
  22.     lblUrl: TLabel;
  23.     procedure btnCruncherClick(Sender: TObject);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure lblUrlClick(Sender: TObject);
  26.     procedure lbResultDblClick(Sender: TObject);
  27.   private
  28.     procedure ReassignCandidates(list: TStringList);
  29.     { Private declarations }
  30.   public
  31.     { Public declarations }
  32.   end;
  33.  
  34. var
  35.   formMain: TformMain;
  36.  
  37. implementation
  38.  
  39. uses ShellAPI;
  40. {$R *.dfm}
  41.  
  42. procedure TformMain.btnCruncherClick(Sender: TObject);
  43. var
  44.   i: integer;
  45.   word: String;
  46.   finish: Boolean;
  47.   j: integer;
  48.   letter: String;
  49.   list: TStringList;
  50.   index: integer;
  51.   maxWord: integer;
  52.   found: Boolean;
  53.   answerLength: integer;
  54. begin
  55.   if Length(edCandidates.Text) <> 12 then
  56.   begin
  57.     MessageDlg('Please put all 12 candidates of letter', mtError, [mbOK], 0);
  58.     edCandidates.SetFocus;
  59.   end
  60.   else if cmbLength.Text = '' then
  61.   begin
  62.     MessageDlg('Please choose the length of the answer', mtError, [mbOK], 0);
  63.     cmbLength.SetFocus;
  64.   end
  65.   else
  66.   begin
  67.     lbResult.Items.Clear;
  68.     lblStatistic.Caption := '';
  69.     i := 0;
  70.     list := TStringList.Create;
  71.     ProgressBar.Position := 0;
  72.     maxWord := mmDictionary.Lines.Count;
  73.     ProgressBar.Max := maxWord;
  74.     answerLength := StrToIntDef(cmbLength.Text, 0);
  75.     while (i < maxWord) do
  76.     begin
  77.       word := UpperCase(mmDictionary.Lines[i]);
  78.  
  79.       if Length(word) = answerLength then
  80.       begin
  81.         ReassignCandidates(list);
  82.  
  83.         j := 1;
  84.         finish := false;
  85.         found := true;
  86.         while (Not finish) and (j <= answerLength) do
  87.         begin
  88.           letter := Copy(word, j, 1);
  89.           index := list.IndexOf(letter);
  90.           if index >= 0 then
  91.           begin
  92.             list.Delete(index);
  93.             Inc(j);
  94.           end
  95.           else
  96.           begin
  97.             finish := true;
  98.             found := false;
  99.           end;
  100.         end;
  101.  
  102.         if found then
  103.         begin
  104.           if lbResult.Items.IndexOf(word) = -1 then
  105.             lbResult.Items.Add(word);
  106.         end;
  107.  
  108.         Application.ProcessMessages;
  109.       end;
  110.       ProgressBar.StepBy(1);
  111.       Inc(i);
  112.     end;
  113.     list.Free;
  114.  
  115.     if lbResult.Items.Count > 0 then
  116.     begin
  117.       lblStatistic.Caption := 'You got ' + VarToStr(lbResult.Items.Count)
  118.         + ' possible answer(s) among ' + VarToStr(mmDictionary.Lines.Count)
  119.         + ' English words in the dictionary';
  120.     end
  121.     else
  122.     begin
  123.       lblStatistic.Caption := 'No possible words found in the dictionary. ' +
  124.         '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';
  125.     end;
  126.   end;
  127. end;
  128.  
  129. procedure TformMain.FormCreate(Sender: TObject);
  130. var
  131.   dictFile: string;
  132. begin
  133.   dictFile := ExtractFileDir(ParamStr(0)) + '\dictionary.txt';
  134.   if FileExists(dictFile) then
  135.     try
  136.       mmDictionary.Lines.LoadFromFile(dictFile);
  137.     except
  138.       MessageDlg('Cannot load ' +
  139.           'file ''dictionary.txt''. It may be corrupted. Please reinstall.',
  140.         mtError, [mbOK], 0);
  141.     end
  142.   else
  143.     MessageDlg('No dictionary found. Please ensure that ' +
  144.         'file ''dictionary.txt'' is in the same folder with this application.',
  145.       mtError, [mbOK], 0);
  146. end;
  147.  
  148. procedure TformMain.lblUrlClick(Sender: TObject);
  149. begin
  150.   ShellExecute(0, 'open', PChar('iexplore.exe'), PChar(
  151.       'http://wisnuwidiarta.wordpress.com/tag/drawsomething'), nil, SW_SHOW);
  152. end;
  153.  
  154. procedure TformMain.lbResultDblClick(Sender: TObject);
  155. var
  156.   url: string;
  157. begin
  158.   if lbResult.ItemIndex <> -1 then
  159.   begin
  160.     url := 'http://dictionary.reference.com/browse/' + lbResult.Items
  161.       [lbResult.ItemIndex];
  162.  
  163.     ShellExecute(0, 'open', PChar('iexplore.exe'), PChar(url), nil, SW_SHOW);
  164.   end;
  165. end;
  166.  
  167. procedure TformMain.ReassignCandidates(list: TStringList);
  168. var
  169.   i: integer;
  170.   len: integer;
  171. begin
  172.   list.Clear;
  173.   len := Length(edCandidates.Text);
  174.   for i := 1 to len do
  175.     list.Add(UpperCase(Copy(edCandidates.Text, i, 1)));
  176. end;
  177.  
  178. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top