{ ******************************************************************************** YaPeTaVi - Yet another Periodic Table Viewer Copyright (C) 1997-2000, 2009 Geoffray Levasseur . 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.