yapetavi/frmmasscalculator.pas

{
********************************************************************************

YaPeTaVi - Yet another Periodic Table Viewer
Copyright (C) 1997-2000, 2009 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
All rights reserved.
http://www.geoffray-levasseur.org/

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 3 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.

You should have received a copy of the GNU General Public License along with
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
Place - Suite 330, Boston, MA  02111-1307, USA.

********************************************************************************

Description:
  Mass calculator form unit

}
{$warning frmMassCalculator: change french strings in english resourcestring}
unit frmMassCalculator;

{$mode objfpc}{$H+}
interface

uses
  {Windows,} SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  ComCtrls, ExtCtrls, Menus, LResources, Buttons, uConst, uElemListClass,
  uCommon;

type

  { TMassCalcForm }

  TMassCalcForm = class(TForm)
    btnGo: TBitBtn;
    btnClear: TBitBtn;
    btnSave: TBitBtn;
    btnClose: TBitBtn;
    Edit: TEdit;
    Memo: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Bevel1: TBevel;
    Timer1: TTimer;
    SaveDialog: TSaveDialog;
    Label12: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnGoClick(Sender: TObject);
    procedure btnClearClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure EditChange(Sender: TObject);
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    procedure btnSaveClick(Sender: TObject);
  private
    procedure Analyse(Elm: TElement);
    procedure Decompose;
    procedure ChError;
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Entry: String;
  Rep, G, St, X: Byte;
  IsTested : Array[1..ElemNumber] of Boolean;
  Result : Real;
  Stat: Boolean;
  MassCalcForm: TMassCalcForm;

implementation

uses
  uIconManager;

procedure TMassCalcForm.FormCreate(Sender: TObject);
begin
  {Initialise l'affichage de l'aide dans la barre d'état}
//  Application.OnHint := ShowHint(Application);
  {Au début le boutton Démarrage doit être désactivé}
  InitBtnGlyphs(Self);
  btnGo.Enabled := False;
  {Charge les paramètres du registres}
end;

procedure TMassCalcForm.ChError;
begin
  {Indication d'érreur}
  Memo.Lines.Add('    -- Erreur au caractère ' + IntToStr(Rep));
end;

procedure TMassCalcForm.Analyse(Elm: TElement);
var
  Inc: Boolean;
begin
  Inc := Length(Trim(Elm.ShortName)) > 1;
  {Détecte si l'élément est déjà présent}  
  if IsTested[Elm.Number] then
    Memo.Lines.Add('    L''élément ' + Elm.Name +
      ' a déja été incorporé ! Simplifiez votre formule...');
  {Ajout de l'élément dans le tableau des élément déjà analysé}
  IsTested[Elm.Number] := True;
  {Une lettre : on n'incrémente pas. Deux lettre : on incrémente}
  if Inc then Rep := Rep + 1;
  {Un élément différent des autres de plus}
  G := G + 1;
  {Stocke la masse molaire}
  Elem[G].Typ := Elm.Number;
  {Détection des chiffres - volontairement limité à 2}
  if Entry[Rep + 1] in ['1'..'9'] then
  begin
    Rep := Rep + 1;
    if entry[Rep + 1] in ['0'..'9'] then
    begin
      Elem[G].Num := ((Ord(Entry[Rep]) - 48) * 10) + (Ord(Entry[Rep + 1]) - 48);
      Rep := Rep + 1;
    end else
      Elem[G].Num := Ord(Entry[Rep]) - 48;
  end else Elem[G].Num := 1;
  {Affiche les caractèristique de l'élément}
  if ElementsList.Elements[Elem[G].Typ].Radioactivity <> '' then
    Memo.Lines.Add('    ' + IntToStr(Elem[G].Num) + ' ' +
      ElementsList.Elements[Elem[G].Typ].Name + ' / Masse Molaire pour un : ' +
      FloatToStr(ElementsList.Elements[Elem[G].Typ].Mass) + ', soit : ' +
      FloatToStr(Elem[G].Num * ElementsList.Elements[Elem[G].Typ].Mass) +
      ' (Artificial et/or radioactive!)')
  else
    Memo.Lines.Add('    ' + IntToStr(Elem[G].Num) + ' ' +
      ElementsList.Elements[Elem[G].Typ].Name + ' / Masse Molaire pour un : ' +
      FloatToStr(ElementsList.Elements[Elem[G].Typ].Mass) + ', soit : ' +
      FloatToStr(Elem[G].Num * ElementsList.Elements[Elem[G].Typ].Mass));
  {Met à jour le resultat}
  Result := Result + (Elem[G].Num * ElementsList.Elements[Elem[G].Typ].Mass);
  {Incrémente le compteur du nombre d'éléments}
  X := X + Elem[G].Num;
end;

procedure TMassCalcForm.Decompose;
var L, J: Byte;
begin
  {Initialisation}
  if Memo.Lines.Count <> 0 then
    Memo.Lines.Add('');
  Memo.Lines.Add('Analysing the string "' + Edit.Text + '"...');
  for J := 1 to
    ElemNumber do IsTested[J] := False;
  Entry := Edit.Text + #255; //facility to find the end of the string
  St := 0;
  Stat := True;
  Result := 0;
  G := 0;
  X := 0;
  Rep := 0;
  L := Length(Entry);
  //analysing char by char using case system (this have been writen a while ago
  //so rewriting this with more efficiency, more possibility and less code would
  //be great XD)
  {$warning rewritind the awful and outdated TMassCalcForm.Decompose}
  For Rep := 1 to L do
  begin
    case Entry[Rep] of
      'A' : Case Entry[Rep+1] of
              'l' : Analyse(Al);
              's' : Analyse(Ars);
              'g' : Analyse(Ag);
              'u' : Analyse(Au);
              't' : Analyse(At);
              'c' : Analyse(Ac);
              'm' : Analyse(Am);
              'r' : Analyse(Ar);
              else ChError
            end;
      'B' : if Entry[Rep+1] in ['a'..'z'] then
            begin
              case Entry[Rep+1] of
                'r' : Analyse(Br);
                'i' : Analyse(Bi);
                'k' : Analyse(Bk);
                'e' : Analyse(Be);
                'a' : Analyse(Ba);
                'h' : Analyse(Bh);
                else Cherror
              end;
            end else Analyse(B);
      'C' : if Entry[Rep+1] in ['a'..'z'] then
            begin
              case Entry[Rep+1] of
                'l' : Analyse(Cl);
                'o' : Analyse(Co);
                'u' : Analyse(Cu);
                's' : Analyse(Cs);
                'a' : Analyse(Ca);
                'r' : Analyse(Cr);
                'd' : Analyse(Cd);
                'e' : Analyse(Ce);
                'm' : Analyse(Cm);
                'f' : Analyse(Cf);
                else Cherror
              end;
            end else Analyse(C);
      'D' : case Entry[Rep+1] of
              'y' : Analyse(Dy);
              'b' : Analyse(Db);
              's' : Analyse(Ds);
              else ChError;
            end;
      'E' : case Entry[Rep+1] of
              'u' : Analyse(Eu);
              'r' : Analyse(Er);
              's' : Analyse(Es);
              else Cherror
            end;
      'F' : if Entry[Rep+1] in ['a'..'z'] then
            begin
              case Entry[Rep+1] of
                'e' : Analyse(Fe);
                'r' : Analyse(Fr);
                'm' : Analyse(Fm);
                else Cherror
              end;
            end else Analyse(F);
      'G' : case Entry[Rep+1] of
              'a' : Analyse(Ga);
              'e' : Analyse(Ge);
              'd' : Analyse(Gd);
              else Cherror
            end;
      'H' : if Entry[Rep+1] in ['a'..'z'] then
            begin
              case Entry[Rep+1] of
                'e' : Analyse(He);
                'o' : Analyse(Ho);
                'f' : Analyse(Hf);
                'g' : Analyse(Hg);
                's' : Analyse(Hs);
                else Cherror
              end;
            end else Analyse(H);
      'I' : if Entry[Rep+1] in ['a'..'z'] then
            begin
              case Entry[Rep+1] of
                'n' : Analyse(Ind);
                'r' : Analyse(Ir);
                else Cherror
              end;
            end else Analyse(I);
      'K' : if Entry[Rep+1]='r' then
              Analyse(Kr)
            else Analyse(K);
      'L' : case Entry[Rep+1] of
              'i' : Analyse(Li);
              'a' : Analyse(La);
              'r' : Analyse(Lr);
              'u' : Analyse(Lu);
              else Cherror
            end;
      'M' : case Entry[Rep+1] of
              'g' : Analyse(Mg);
              'n' : Analyse(Mn);
              'o' : Analyse(Mo);
              'd' : Analyse(Md);
              't' : Analyse(Mt);
              else Cherror
            end;
      'N' : if Entry[Rep+1] in ['a'..'z'] then
            begin
              case Entry[Rep+1] of
                'e' : Analyse(Ne);
                'a' : Analyse(Na);
                'i' : Analyse(Ni);
                'b' : Analyse(Nb);
                'd' : Analyse(Nd);
                'p' : Analyse(Np);
                'o' : Analyse(No);
                else Cherror
              end;
            end else Analyse(N);
      'O' : if Entry[Rep+1]='s' then
              Analyse(Os)
            else
              Analyse(O);
      'P' : if Entry[Rep+1] in ['a'..'z'] then
            begin
              case Entry[Rep+1] of
                'd' : Analyse(Pd);
                'r' : Analyse(Pr);
                'm' : Analyse(Pm);
                't' : Analyse(Pt);
                'b' : Analyse(Pb);
                'o' : Analyse(Po);
                'a' : Analyse(Pa);
                'u' : Analyse(Pu);
                else Cherror
              end;
            end else Analyse(P);
      'R' : case Entry[Rep+1] of
              'b' : Analyse(Rb);
              'u' : Analyse(Ru);
              'h' : Analyse(Rh);
              'e' : Analyse(Re);
              'n' : Analyse(Rn);
              'a' : Analyse(Re);
              'f' : Analyse(Rf);
              'g' : Analyse(Rg);
              else Cherror
            end;
      'S' : if Entry[Rep+1] in ['a'..'z'] then
            begin
              case Entry[Rep+1] of
                'b' : Analyse(Sb);
                'c' : Analyse(Sc);
                'e' : Analyse(Se);
                'g' : Analyse(Sg);
                'i' : Analyse(Si);
                'm' : Analyse(Sm);
                'n' : Analyse(Sn);
                'r' : Analyse(Sr);
                else Cherror
              end;
            end else Analyse(S);
      'T' : case Entry[Rep+1] of
              'a' : Analyse(Ta);
              'b' : Analyse(Tb);
              'c' : Analyse(Tc);
              'e' : Analyse(Te);
              'h' : Analyse(Th);
              'i' : Analyse(Ti);
              'l' : Analyse(Tl);
              'm' : Analyse(Tm);
              else Cherror
            end;
      'U' : Analyse(U);
      'V' : Analyse(V);
      'W' : Analyse(W);
      'X' : If Entry[Rep+1] = 'e' then
              Analyse(Xe) else ChError;
      'Y' : Analyse(Y);
      'Z' : case Entry[Rep+1] of
              'n' : Analyse(Zn);
              'r' : Analyse(Zr);
              else Cherror
            end;
      {Le caractère 255 est ajouté à l'initialisation et permet la detection
      de la fin de la chaîne}
      #255 : exit;
      else ChError;
    end;
  end;
end;

procedure TMassCalcForm.btnCloseClick(Sender: TObject);
begin
  Close;
  Free;
  MassCalcForm := nil;
end;

procedure TMassCalcForm.btnGoClick(Sender: TObject);
begin
  {Lance la grosse artillerie...}
  Decompose;
  {Affichage des statistique et du résultat}
  Memo.Lines.Add('A total of ' + IntToStr(G) + ' differents items have been found.');
  Memo.Lines.Add('A total of ' + IntToStr(X) + ' atoms have been found.');
  Memo.Lines.Add('Résultat final : ' + FloatToStr(Result));
  Label11.Caption := FloatToStr(Result);
end;

procedure TMassCalcForm.btnClearClick(Sender: TObject);
begin
  {Réinitialise l'affichage de la console et de la ligne d'édition}
  Memo.Clear;
  Edit.Clear;
end;

procedure TMassCalcForm.Timer1Timer(Sender: TObject);
begin
  {Fait clignoter un texte Noir/Rouge}
  if Label8.Font.Color = clRed then
    Label8.Font.Color := clNone
  else Label8.Font.Color := clRed;
end;

procedure TMassCalcForm.EditChange(Sender: TObject);
begin
  {Interdit l'utilisation du boutton démarrage quand Edit est vide}
  btnGo.Enabled := Edit.Text<>'';
end;

procedure TMassCalcForm.EditKeyPress(Sender: TObject; var Key: Char);
begin
  {Gestion de la touche Entrée}
  If (Key = #13) and (Edit.Text <> '') then
    btnGoClick(Self);
end;

procedure TMassCalcForm.btnSaveClick(Sender: TObject);
begin
  {Sauvegarde du contenu de la console}    
  if SaveDialog.Execute then
  begin
    if FileExists(SaveDialog.FileName) then
      if MessageDlg('Are you sure you want to overwrite '+ SaveDialog.FileName
        + '?', mtConfirmation, mbYesNoCancel, 0) <> DR_YES then Exit;
    Memo.Lines.SaveToFile(SaveDialog.FileName);
  end;
end;

initialization
  {$i frmmasscalculator.lrs}

end.