home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kompon / d6 / YPPARSER.ZIP / Generator / MainForm.pas < prev   
Pascal/Delphi Source File  |  2002-06-16  |  14KB  |  388 lines
  1. {********************************************************}
  2. {                                                        }
  3. {                    Generator                           }
  4. {             IMPORTANT-READ CAREFULLY:                  }
  5. {                                                        }
  6. {    This End-User License Agreement is a legal          }
  7. {    agreement between you (either an individual         }
  8. {    or a single entity) and Pisarev Yuriy for           }
  9. {    the software product identified above, which        }
  10. {    includes computer software and may include          }
  11. {    associated media, printed materials, and "online"   }
  12. {    or electronic documentation ("SOFTWARE PRODUCT").   }
  13. {    By installing, copying, or otherwise using the      }
  14. {    SOFTWARE PRODUCT, you agree to be bound by the      }
  15. {    terms of this LICENSE AGREEMENT.                    }
  16. {                                                        }
  17. {    If you do not agree to the terms of this            }
  18. {    LICENSE AGREEMENT, do not install or use            }
  19. {    the SOFTWARE PRODUCT.                               }
  20. {                                                        }
  21. {    License conditions                                  }
  22. {                                                        }
  23. {    No part of the software or the manual may be        }
  24. {    multiplied, disseminated or processed in any        }
  25. {    way without the written consent of Pisarev          }
  26. {    Yuriy. Violations of these conditions will be       }
  27. {    prosecuted in every case.                           }
  28. {                                                        }
  29. {    The use of the software is done at your own         }
  30. {    risk. The manufacturer and developer accepts        }
  31. {    no liability for any damages, either as direct      }
  32. {    or indirect consequence of the use of this          }
  33. {    product or software.                                }
  34. {                                                        }
  35. {    Only observance of these conditions allows you      }
  36. {    to use the hardware and software in your computer   }
  37. {    system.                                             }
  38. {                                                        }
  39. {    All rights reserved.                                }
  40. {    Copyright 2002 Pisarev Yuriy                        }
  41. {                                                        }
  42. {                 yuriy_mbox@hotmail.com                 }
  43. {                                                        }
  44. {********************************************************}
  45.  
  46. unit MainForm;
  47.  
  48. interface
  49.  
  50. uses
  51.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  52.   Dialogs, ToolWin, ActnMan, ActnCtrls, StdCtrls, ActnList, ComCtrls,
  53.   StdActns, ImgList, ActnMenus, Menus, DataEditor, Math, ExtCtrls, AppEvnts,
  54.   ExtActns;
  55.  
  56. type
  57.   TTextInfo = record
  58.     Text: string;
  59.     ElementsCount: Integer;
  60.   end;
  61.  
  62.   TFunction = record
  63.     FunctionName: string;
  64.     RequireValue1, RequireValue2: Boolean;
  65.   end;
  66.   TFunctions = array of TFunction;
  67.  
  68.   TProbability = 10..90;
  69.  
  70.   TMain = class(TForm)
  71.     ActionManager1: TActionManager;
  72.     ImageList1: TImageList;
  73.     RichEdit: TRichEdit;
  74.     HelpAbout: TAction;
  75.     ActionMainMenuBar1: TActionMainMenuBar;
  76.     PopupMenu1: TPopupMenu;
  77.     ServiceGenerate: TAction;
  78.     StatusBar: TStatusBar;
  79.     Panel1: TPanel;
  80.     gbSettings: TGroupBox;
  81.     tbElementsCount: TTrackBar;
  82.     ServiceExecute: TAction;
  83.     ApplicationEvents1: TApplicationEvents;
  84.     Label1: TLabel;
  85.     rgFunctions: TRadioGroup;
  86.     tbEmbeddingsFactor: TTrackBar;
  87.     Label2: TLabel;
  88.     EditCut: TEditCut;
  89.     EditCopy: TEditCopy;
  90.     EditPaste: TEditPaste;
  91.     EditSelectAll: TEditSelectAll;
  92.     EditUndo: TEditUndo;
  93.     EditDelete: TEditDelete;
  94.     FileOpen: TFileOpen;
  95.     FileSaveAs: TFileSaveAs;
  96.     FileExit: TFileExit;
  97.     FileSave: TAction;
  98.     FilePrint: TAction;
  99.     Undo1: TMenuItem;
  100.     N1: TMenuItem;
  101.     Cut1: TMenuItem;
  102.     Copy1: TMenuItem;
  103.     Paste1: TMenuItem;
  104.     Delete1: TMenuItem;
  105.     N2: TMenuItem;
  106.     SelectAll1: TMenuItem;
  107.     procedure FormCreate(Sender: TObject);
  108.     procedure FormDestroy(Sender: TObject);
  109.     procedure ApplicationEvents1Hint(Sender: TObject);
  110.     procedure ServiceGenerateExecute(Sender: TObject);
  111.     procedure ServiceExecuteExecute(Sender: TObject);
  112.     procedure FileOpenAccept(Sender: TObject);
  113.     procedure FileSaveExecute(Sender: TObject);
  114.     procedure FileSaveUpdate(Sender: TObject);
  115.     procedure FileSaveAsAccept(Sender: TObject);
  116.     procedure FilePrintExecute(Sender: TObject);
  117.     procedure tbElementsCountChange(Sender: TObject);
  118.     procedure rgFunctionsClick(Sender: TObject);
  119.     procedure HelpAboutExecute(Sender: TObject);
  120.     procedure tbEmbeddingsFactorChange(Sender: TObject);
  121.   private
  122.     FMax: Integer;
  123.     FMin: Integer;
  124.     FNumbers: string;
  125.     FFileName: string;
  126.     FDataEditor: TDataEditor;
  127.     FFunctions: TFunctions;
  128.     FEmbeddingsFactor: TProbability;
  129.   protected
  130.     property Functions: TFunctions read FFunctions write FFunctions;
  131.   public
  132.     function Generate(Min, Max, EmbeddingsFactor: Integer;
  133.       Functions: TFunctions; Numbers: string): TTextInfo;
  134.     property FileName: string read FFileName write FFileName;
  135.     property DataEditor: TDataEditor read FDataEditor write FDataEditor;
  136.     property Numbers: string read FNumbers write FNumbers;
  137.     property Max: Integer read FMax write FMax;
  138.     property Min: Integer read FMin write FMin;
  139.     property EmbeddingsFactor: TProbability read FEmbeddingsFactor
  140.       write FEmbeddingsFactor;
  141.   end;
  142.  
  143. const
  144.   sNumbers = '0123456789';
  145.   sStandardNumbers = '123456789';
  146.  
  147.   Links: array[0..2] of string = ('', '-', '+');
  148.   MinElementsCount = 5;
  149.  
  150.   StandardFunctions: array[0..1] of TFunction = (
  151.     (FunctionName: '*'; RequireValue1: True; RequireValue2: True),
  152.     (FunctionName: '/'; RequireValue1: True; RequireValue2: True));
  153.  
  154. resourcestring
  155.   MenuFileName = 'Menu.dat';
  156.  
  157. var
  158.   Main: TMain;
  159.  
  160. implementation
  161.  
  162. {$R *.dfm}
  163.  
  164. { TMain }
  165.  
  166. function TMain.Generate(Min, Max, EmbeddingsFactor: Integer;
  167.   Functions: TFunctions; Numbers: string): TTextInfo;
  168.  
  169.   function SubCode(Count: Integer; var TextInfo: TTextInfo): Boolean;
  170.   begin
  171.     Result := (Count >= MinElementsCount) and
  172.       (EmbeddingsFactor >= Random(100));
  173.     if Result then TextInfo := Generate(MinElementsCount,
  174.       Count, EmbeddingsFactor, Functions, Numbers);
  175.   end;
  176.  
  177. var
  178.   I, J, NumbersCount: Integer;
  179.   TextInfo: TTextInfo;
  180.   S1, S2: string;
  181. begin
  182.   FillChar(Result, SizeOf(Result), 0);
  183.   NumbersCount := Length(Numbers);
  184.   J := Min + Random(Max - Min + 1);
  185.   while Result.ElementsCount <= J do begin
  186.     I := Random(Length(Functions));
  187.     with Functions[I] do
  188.       if RequireValue1 and RequireValue2 then begin
  189.         if Result.Text = '' then begin
  190.           S1 := Links[Random(2)] + Numbers[1 + Random(NumbersCount)];
  191.           Inc(Result.ElementsCount);
  192.         end else if SubCode(J - Result.ElementsCount, TextInfo) then begin
  193.           S1 := Links[1 + Random(2)] + '(' + TextInfo.Text + ')';
  194.           Inc(Result.ElementsCount, TextInfo.ElementsCount);
  195.         end else begin
  196.           S1 := Links[1 + Random(2)] + Numbers[1 + Random(NumbersCount)];
  197.           Inc(Result.ElementsCount);
  198.         end;
  199.         if SubCode(J - Result.ElementsCount, TextInfo) then begin
  200.           S2 := '(' + TextInfo.Text + ')';
  201.           Inc(Result.ElementsCount, TextInfo.ElementsCount);
  202.         end else begin
  203.           S2 := Numbers[1 + Random(NumbersCount)];
  204.           Inc(Result.ElementsCount);
  205.         end;
  206.         Result.Text := Result.Text + S1 + FunctionName + S2;
  207.         Inc(Result.ElementsCount);
  208.       end else if not RequireValue1 and RequireValue2 then begin
  209.         if Result.Text = '' then S1 := Links[Random(2)]
  210.         else S1 := Links[1 + Random(2)];
  211.         if SubCode(J - Result.ElementsCount, TextInfo) then begin
  212.           S2 := '(' + TextInfo.Text + ')';
  213.           Inc(Result.ElementsCount, TextInfo.ElementsCount);
  214.         end else begin
  215.           S2 := Numbers[1 + Random(NumbersCount)];
  216.           Inc(Result.ElementsCount);
  217.         end;
  218.         Result.Text := Result.Text + S1 + FunctionName + S2;
  219.         Inc(Result.ElementsCount);
  220.       end else if RequireValue1 and not RequireValue2 then begin
  221.         if Result.Text = '' then begin
  222.           S1 := Links[Random(2)] + Numbers[1 + Random(NumbersCount)];
  223.           Inc(Result.ElementsCount);
  224.         end else if SubCode(J - Result.ElementsCount, TextInfo) then begin
  225.           S1 := Links[1 + Random(2)] + '(' + TextInfo.Text + ')';
  226.           Inc(Result.ElementsCount, TextInfo.ElementsCount);
  227.         end else begin
  228.           S1 := Links[1 + Random(2)] + Numbers[1 + Random(NumbersCount)];
  229.           Inc(Result.ElementsCount);
  230.         end;
  231.         Result.Text := Result.Text + S1 + FunctionName;
  232.         Inc(Result.ElementsCount);
  233.       end else begin
  234.         if Result.Text = '' then S1 := Links[Random(2)]
  235.         else S1 := Links[1 + Random(2)];
  236.         Result.Text := Result.Text + S1 + FunctionName;
  237.         Inc(Result.ElementsCount);
  238.       end;
  239.   end;
  240. end;
  241.  
  242. procedure TMain.FormCreate(Sender: TObject);
  243. begin
  244.   FDataEditor := TDataEditor.Create(Self);
  245.   with ActionManager1 do begin
  246.     FileName := ExtractFilePath(Application.ExeName) + MenuFileName;
  247.     if FileExists(FileName) then LoadFromFile(FileName);
  248.   end;
  249.   rgFunctionsClick(nil);
  250.   tbElementsCountChange(nil);
  251.   tbEmbeddingsFactorChange(nil);
  252.   Randomize;
  253. end;
  254.  
  255. procedure TMain.FormDestroy(Sender: TObject);
  256. begin
  257.   FFunctions := nil;
  258. end;
  259.  
  260. procedure TMain.ApplicationEvents1Hint(Sender: TObject);
  261. begin
  262.   if Length(Application.Hint) > 0 then begin
  263.     StatusBar.SimplePanel := True;
  264.     StatusBar.SimpleText := Application.Hint
  265.   end else StatusBar.SimplePanel := False;
  266. end;
  267.  
  268. procedure TMain.ServiceGenerateExecute(Sender: TObject);
  269. var
  270.   TextInfo: TTextInfo;
  271.   Value, TickCount: Double;
  272. begin
  273.   Screen.Cursor := crHourGlass;
  274.   try
  275.     with FDataEditor do TextInfo := Generate(FMin, FMax,
  276.       FEmbeddingsFactor, FFunctions, FNumbers);
  277.     TickCount := GetTickCount;
  278.     FDataEditor.StringToNumScript(TextInfo.Text);
  279.     TickCount := GetTickCount - TickCount;
  280.     StatusBar.Panels[2].Text := Format('Translation: %d sec %d msec',
  281.       [Trunc(TickCount / 1000), Trunc(TickCount - Trunc(TickCount / 1000) * 1000)]);
  282.     TickCount := GetTickCount;
  283.     Value := FDataEditor.ExecuteNum;
  284.     TickCount := GetTickCount - TickCount;
  285.     StatusBar.Panels[3].Text := Format('Execution: %d sec %d msec',
  286.       [Trunc(TickCount / 1000), Trunc(TickCount - Trunc(TickCount / 1000) * 1000)]);
  287.     StatusBar.Panels[0].Text := Format('Result: %f', [Value]);
  288.     StatusBar.Panels[1].Text := Format('Elements count: %d', [TextInfo.ElementsCount]);
  289.     RichEdit.Lines.Add(TextInfo.Text);
  290.   finally
  291.     Screen.Cursor := crDefault;
  292.   end;
  293. end;
  294.  
  295. procedure TMain.ServiceExecuteExecute(Sender: TObject);
  296. var
  297.   Value, TickCount: Double;
  298. begin
  299.   Screen.Cursor := crHourGlass;
  300.   try
  301.     TickCount := GetTickCount;
  302.     FDataEditor.StringToNumScript(RichEdit.Text);
  303.     TickCount := GetTickCount - TickCount;
  304.     StatusBar.Panels[2].Text := Format('Translation: %d sec %d msec',
  305.       [Trunc(TickCount / 1000), Trunc(TickCount - Trunc(TickCount / 1000) * 1000)]);
  306.     TickCount := GetTickCount;
  307.     Value := FDataEditor.ExecuteNum;
  308.     TickCount := GetTickCount - TickCount;
  309.     StatusBar.Panels[3].Text := Format('Execution: %d sec %d msec',
  310.       [Trunc(TickCount / 1000), Trunc(TickCount - Trunc(TickCount / 1000) * 1000)]);
  311.     StatusBar.Panels[0].Text := Format('Result: %f', [Value]);
  312.     StatusBar.Panels[1].Text := '';
  313.   finally
  314.     Screen.Cursor := crDefault;
  315.   end;
  316. end;
  317.  
  318. procedure TMain.FileOpenAccept(Sender: TObject);
  319. begin
  320.   FFileName := FileOpen.Dialog.FileName;
  321.   RichEdit.Lines.LoadFromFile(FFileName);
  322. end;
  323.  
  324. procedure TMain.FileSaveExecute(Sender: TObject);
  325. begin
  326.   with FileSaveAs.Dialog do if FileExists(FileName) then
  327.     RichEdit.Lines.SaveToFile(FileName);
  328. end;
  329.  
  330. procedure TMain.FileSaveUpdate(Sender: TObject);
  331. begin
  332.   FileSave.Enabled := FileExists(FFileName);
  333. end;
  334.  
  335. procedure TMain.FileSaveAsAccept(Sender: TObject);
  336. begin
  337.   FFileName := FileSaveAs.Dialog.FileName;
  338.   RichEdit.Lines.SaveToFile(FFileName);
  339. end;
  340.  
  341. procedure TMain.FilePrintExecute(Sender: TObject);
  342. begin
  343.   RichEdit.Print('');
  344. end;
  345.  
  346. procedure TMain.tbElementsCountChange(Sender: TObject);
  347. begin
  348.   FMin := tbElementsCount.Position * 100;
  349.   FMax := tbElementsCount.Position * 100;
  350. end;
  351.  
  352. procedure TMain.tbEmbeddingsFactorChange(Sender: TObject);
  353. begin
  354.   FEmbeddingsFactor := tbEmbeddingsFactor.Position * 10;
  355. end;
  356.  
  357. procedure TMain.rgFunctionsClick(Sender: TObject);
  358. var
  359.   I, J: Integer;
  360. begin
  361.   if rgFunctions.ItemIndex = 0 then with FDataEditor do begin
  362.     SetLength(FFunctions, Length(NumFunctionsData) - 1);
  363.     J := 0;
  364.     for I := Low(NumFunctionsData) to High(NumFunctionsData) do
  365.       with NumFunctionsData[I] do if PInteger(P)^ = NumReservedID then Inc(J)
  366.       else begin
  367.         FFunctions[I - J].FunctionName := FunctionName;
  368.         FFunctions[I - J].RequireValue1 := RequireValue1;
  369.         FFunctions[I - J].RequireValue2 := RequireValue2;
  370.       end;
  371.     FNumbers := sNumbers;
  372.   end else begin
  373.     SetLength(FFunctions, Length(StandardFunctions));
  374.     for I := Low(StandardFunctions) to High(StandardFunctions) do
  375.       FFunctions[I] := StandardFunctions[I];
  376.     FNumbers := sStandardNumbers;
  377.   end;
  378. end;
  379.  
  380. procedure TMain.HelpAboutExecute(Sender: TObject);
  381. begin
  382.   MessageBox(0, 'Demonstration program "Generator" and parser ' +
  383.     '"TDataEditor" are written by Pisarev Yuriy. You can contact ' +
  384.     'with me by address: yuriy_mbox@hotmail.com', 'About program', mb_Ok);
  385. end;
  386.  
  387. end.
  388.