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

191
usort.pas Normal file
View File

@@ -0,0 +1,191 @@
{
********************************************************************************
YaPeTaVi - Yet another Periodic Table Viewer
Copyright (C) 2011-2012 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:
Sort procedure used by ElemList class
}
unit uSort;
{$mode objfpc}
interface
uses
Classes, SysUtils, uElemListClass;
procedure SortByAtNum(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown: Boolean);
procedure SortByName(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown: Boolean);
procedure SortByShortName(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown: Boolean);
procedure SortByMass(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown: Boolean);
procedure SortByDate(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown, UnknowFirst: Boolean);
implementation
uses
uConst, uDebug, uCommon;
type
TSorted = array[1..ElemNumber] of Boolean;
var
Sorted: TSorted;
procedure InitSorted;
var
I: integer;
begin
for I := 1 to ElemNumber do
Sorted[I] := False;
end;
procedure SortByAtNum(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown: Boolean);
var
I: Integer;
begin
//sorted is unneeded as we just copy the two arrays
for I := 1 to ElemNumber do
if not UpToDown then
TDest[I] := TOrig[I]
else
TDest[ElemNumber - I + 1] := TOrig[I];
end;
procedure SortByName(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown: Boolean);
var
I, J: integer;
MinItm: Integer;
begin
InitSorted;
PrintLnDbg('Sorting by name...', vlHigh);
for I := 1 to ElemNumber do
begin
MinItm := 0;
for J := 1 to ElemNumber do
if not Sorted[J] then
if (MinItm = 0) or (TOrig[J].Name <= TOrig[MinItm].Name) then
MinItm := J;
Sorted[MinItm] := True;
if UpToDown then
TDest[ElemNumber - I + 1] := TOrig[MinItm]
else
TDest[I] := TOrig[MinItm];
end;
end;
procedure SortByShortName(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown: Boolean);
var
I, J: integer;
MinItm: Integer;
begin
InitSorted;
PrintLnDbg('Sorting by symbol...', vlHigh);
for I := 1 to ElemNumber do
begin
MinItm := 0;
for J := 1 to ElemNumber do
if not Sorted[J] then
if (MinItm = 0) or (TOrig[J].ShortName <= TOrig[MinItm].ShortName) then
MinItm := J;
Sorted[MinItm] := True;
if UpToDown then
TDest[ElemNumber - I + 1] := TOrig[MinItm]
else
TDest[I] := TOrig[MinItm];
end;
end;
procedure SortByMass(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown: Boolean);
var
I, J: integer;
MinItm: Integer;
begin
InitSorted;
PrintLnDbg('Sorting by mass...', vlHigh);
for I := 1 to ElemNumber do
begin
MinItm := 0;
for J := 1 to ElemNumber do
if not Sorted[J] then
if (MinItm = 0) or (TOrig[J].Mass <= TOrig[MinItm].Mass) then
MinItm := J;
Sorted[MinItm] := True;
if UpToDown then
TDest[ElemNumber - I + 1] := TOrig[MinItm]
else
TDest[I] := TOrig[MinItm];
end;
end;
procedure SortByDate(const TOrig: TElemArray; var TDest: TElemArray;
UpToDown, UnknowFirst: Boolean);
var
I, J, K: integer;
MinItm: Integer;
begin
InitSorted;
K := 0;
PrintLnDbg('Sorting by date...', vlHigh);
for I := 1 to ElemNumber do
if TOrig[I].DiscoYear = 0 then
begin
Inc(K);
if UnknowFirst then
TDest[K] := TOrig[I]
else
TDest[ElemNumber - K + 1] := TOrig[I];
Sorted[I] := True;
end;
for I := K to ElemNumber do
begin
MinItm := 0;
for J := 1 to ElemNumber do
if not Sorted[J] then
if (MinItm = 0) or (TOrig[J].DiscoYear <= TOrig[MinItm].DiscoYear) then
MinItm := J;
Sorted[MinItm] := True;
if UpToDown then
if UnknowFirst then
TDest[ElemNumber - I + K + 1] := TOrig[MinItm]
else
TDest[ElemNumber - I + 1] := TOrig[MinItm]
else
if UnknowFirst then
TDest[I] := TOrig[MinItm]
else
TDest[I - K + 1] := TOrig[MinItm];
end;
end;
end.