fatalerrors/yapetavi
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

initial commit moved from svn

Browse Source
This commit is contained in:
fatalerrors
2022-10-24 22:07:20 +02:00
parent b2caa19213
commit 0e96f4f5e4
229 changed files with 20039 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

432
frmmasscalculator.pas Normal file
View File

@@ -0,0 +1,432 @@
{
********************************************************************************
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.