home *** CD-ROM | disk | FTP | other *** search
/ Revista do CD-ROM 123 / cdrom123.iso / compl / dicio / dicionario.pas next >
Encoding:
Pascal/Delphi Source File  |  2005-08-29  |  6.3 KB  |  235 lines
  1. unit form_main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, interface_script, Printers, ShellApi;
  8.  
  9. type
  10.   TformMain = class(TForm)
  11.     editPalavra: TEdit;
  12.     memoTraducao: TMemo;
  13.     listPalavras: TListBox;
  14.     cbIdioma: TComboBox;
  15.     imFundo: TImage;
  16.     imCopiar: TImage;
  17.     imImprimir: TImage;
  18.     imTraduzir: TImage;
  19.     imEmail: TImage;
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure cbIdiomaChange(Sender: TObject);
  22.     procedure FormDestroy(Sender: TObject);
  23.     procedure PreencheLista(S: String);
  24.     function RemoveAcentos(S:String):String;
  25.     procedure TraduzTexto(S: String);
  26.     procedure listPalavrasClick(Sender: TObject);
  27.     procedure imTraduzirClick(Sender: TObject);
  28.     procedure imCopiarClick(Sender: TObject);
  29.     procedure imImprimirClick(Sender: TObject);
  30.     procedure imEmailClick(Sender: TObject);
  31.   private
  32.     { Private declarations }
  33.   public
  34.     { Public declarations }
  35.   end;
  36.  
  37. var
  38.   formMain: TformMain;
  39.   MainPath: String;
  40.   Lista, Doc, Ind: TStringList;
  41.  
  42. implementation
  43.  
  44. uses form_Aguarde;
  45.  
  46. {$R *.DFM}
  47.  
  48. procedure TformMain.FormCreate(Sender: TObject);
  49. var
  50.      i: Integer;
  51. begin
  52.   caption := Application.Title;
  53.  
  54.   //Criaτπo do MainPath
  55.   MainPath := ExtractFilePath(Application.ExeName);
  56.   if MainPath[Length(MainPath)]<>'\' then MainPath := MainPath + '\';
  57.   MainPath := MainPath+'dados\';
  58.  
  59.   //Preenche a o Combo com a lista de dicionßrio
  60.   Lista := TStringList.Create;
  61.   if FileExists(MainPath+'lista.txt') then Lista.LoadFromFile(MainPath+'lista.txt') else Lista.Text:='';
  62.   for i:=0 to Lista.Count-1 do
  63.   begin
  64.     cbIdioma.Items.Add(Copy(Lista[i],pos('=',Lista[i])+1,Length(Lista[i])));
  65.   end;
  66.   cbIdioma.Sorted:=True;
  67.   cbIdioma.Text:='Selecione os Idiomas desejados.';
  68.  
  69.   //StringList que vai conter o dicionario do idioma selecionado sem alteraτπo
  70.   Doc:=TStringList.Create;
  71.   Ind:=TStringList.Create;
  72. end;
  73.  
  74. procedure TformMain.cbIdiomaChange(Sender: TObject);
  75. var
  76.      i: Integer;
  77. begin
  78.   //Doc lΩ o arquivo referente ao idioma escolhido
  79.   Ind.Sorted:=True;
  80.   for i:=0 to Lista.Count-1 do
  81.   begin
  82.     if FileExists(MainPath+Copy(Lista[i],0,pos(cbIdioma.Text,Lista[i])-2)+'.txt') then
  83.     begin
  84.       Doc.LoadFromFile(MainPath+Copy(Lista[i],0,pos(cbIdioma.Text,Lista[i])-2)+'.txt');
  85.       Ind.LoadFromFile(MainPath+Copy(Lista[i],0,pos(cbIdioma.Text,Lista[i])-2)+'.ind');
  86.       break;
  87.     end
  88.     else begin
  89.       Doc.Text:='';
  90.     end;
  91.   end;
  92.   PreencheLista(editPalavra.Text);
  93.   memoTraducao.Clear;
  94. end;
  95.  
  96. procedure TformMain.FormDestroy(Sender: TObject);
  97. begin
  98.   Lista.Free;
  99.   Doc.Free;
  100.   Ind.Free;
  101. end;
  102.  
  103. procedure TformMain.PreencheLista(S: String);
  104. var
  105.      i, Index: Integer;
  106.      Sa, Sb: String;
  107. begin
  108.   listPalavras.Clear;
  109.   if Length(S)>0 then
  110.   begin
  111.   Sa := AnsiUpperCase(RemoveAcentos(S));
  112.     for i:=0 to Ind.Count-1 do
  113.     begin
  114.       Index := StrToInt(Copy(Ind[i],pos('#',Ind[i])+1,length(Ind[i])));
  115.       if (pos(Sa,Ind[i])>0) then
  116.       begin
  117.         listPalavras.Items.Add(Copy(Doc[Index],3,Length(Doc[Index])));
  118.         caption := '     Aguarde... Carregando dicionßrio. '+IntToStr(Trunc(100*i/(Doc.Count-1)))+'%';
  119.       end;
  120.     end;
  121.   end;
  122.   listPalavras.Sorted := True;
  123.   caption:= Application.Title;
  124. end;
  125.  
  126. procedure TformMain.TraduzTexto(S: String);
  127. var
  128.      i, j: Integer;
  129.      Sb, Sa: String;
  130. begin
  131.   memoTraducao.Clear;
  132.  
  133.   Sa := AnsiUpperCase(RemoveAcentos(S));
  134.   for i:=0 to Ind.Count-1 do
  135.   begin
  136.     Sb := Copy(Ind[i],0,pos('#',Ind[i])-1);
  137.     if Sa=Sb then
  138.     begin
  139.       j:=StrToInt(Copy(Ind[i],pos('#',Ind[i])+1,length(Ind[i])))+1;
  140.       while pos('##',Doc[j])=0 do
  141.       begin
  142.         memoTraducao.Lines.Add(Doc[j]);
  143.         Inc(j);
  144.       end;
  145.       break;
  146.     end;
  147.   end;
  148. end;
  149.  
  150. function TformMain.RemoveAcentos(S:String):String;
  151. var I : Integer;
  152. begin
  153.   For I := 1 to Length(S) do
  154.   begin
  155.     if S[i] in ['ß','π','α','Σ','Γ'] then S[i]:='a'
  156.     else if S[i] in ['┴','├','└','─','┬'] then S[i]:='A'
  157.     else if S[i] in ['Θ','Φ','δ','Ω'] then S[i]:='e'
  158.     else if S[i] in ['╔','╚','╦','╩'] then S[i]:='E'
  159.     else if S[i] in ['φ','∞','∩','ε'] then S[i]:='i'
  160.     else if S[i] in ['═','╠','╧','╬'] then S[i]:='I'
  161.     else if S[i] in ['≤','⌡','≥','÷','⌠'] then S[i]:='o'
  162.     else if S[i] in ['╙','╒','╥','╓','╘'] then S[i]:='O'
  163.     else if S[i] in ['·','∙','ⁿ','√'] then S[i]:='u'
  164.     else if S[i] in ['┌','┘','▄','█'] then S[i]:='U'
  165.     else if S[i] in ['²',' '] then S[i]:='y'
  166.     else if S[i] in ['▌','ƒ'] then S[i]:='Y'
  167.     else if S[i] = '±' then S[i]:='n'
  168.     else if S[i] = '╤' then S[i]:='N'
  169.     else if S[i] = 'τ' then S[i]:='c'
  170.     else if S[i] = '╟' then S[i]:='C'
  171.   end;
  172.   Result := S;
  173. end;
  174.  
  175. procedure TformMain.listPalavrasClick(Sender: TObject);
  176. begin
  177.   TraduzTexto(listPalavras.Items[listPalavras.ItemIndex]);
  178. end;
  179.  
  180. procedure TformMain.imTraduzirClick(Sender: TObject);
  181. begin
  182.   TraduzTexto(editPalavra.Text);
  183.   PreencheLista(editPalavra.Text);
  184. end;
  185.  
  186. procedure TformMain.imCopiarClick(Sender: TObject);
  187. begin
  188.   if memoTraducao.SelLength<=0 then
  189.   begin
  190.     memoTraducao.SelectAll;
  191.     memoTraducao.CopyToClipboard;
  192.     memoTraducao.SelLength:=0;
  193.   end else
  194.   begin
  195.     memoTraducao.CopyToClipboard;
  196.   end;
  197. end;
  198.  
  199. procedure TformMain.imImprimirClick(Sender: TObject);
  200. var
  201.      Size: TSize;
  202.      i: Integer;
  203. begin
  204.   with Printer do
  205.   begin
  206.     BeginDoc;
  207.     Canvas.Font.Assign(editPalavra.Font);
  208.     Canvas.Font.Size := 16;
  209.     i:=0;
  210.     while i<memoTraducao.Lines.Count-1 do
  211.     begin
  212.       Size := Printer.Canvas.TextExtent(memoTraducao.lines[i]);
  213.       Canvas.TextOut(250,250+((i*Size.cy)+10),memoTraducao.Lines[i]);
  214.       if (memoTraducao.Lines[i][length(memoTraducao.Lines[i])]=';') or (memoTraducao.Lines[i][length(memoTraducao.Lines[i])]=' ') then
  215.       begin
  216.         Canvas.TextOut(250+Size.cx+10,250+((i*Size.cy)+10),memoTraducao.Lines[i+1]);
  217.         Inc(i,2);
  218.       end else
  219.       begin
  220.         Inc(i);
  221.       end;
  222.     end;
  223.     EndDoc;
  224.   end;
  225.  
  226. end;
  227.  
  228. procedure TformMain.imEmailClick(Sender: TObject);
  229. begin
  230.   if ShellExecute(Handle,'open',PChaR('mailto:diogo@europanet.com.br'),nil,nil,SW_SHOW)<=32
  231.   then MessageBox(Handle,PChar('Nπo existe nenhum cliente de email configutado nesse computador.'),PChar(Application.Title),MB_OK+MB_ICONSTOP+MB_TASKMODAL);
  232. end;
  233.  
  234. end.
  235.