Subversion Repositories general

Compare Revisions

No changes between revisions

Ignore whitespace Rev 1076 → Rev 1077

/Delphi/akPi/Source/CalcUnit.pas
0,0 → 1,172
// akPi v2.2
// Copyright (c) 1997-98 Anatoli Klassen
 
unit CalcUnit;
 
interface
 
uses
Classes, Graphics, ExtCtrls, ComCtrls, LongIntegerUnit, Dialogs;
 
type
TCalc = class(TThread)
private
FRes : PChar;
FStatusBar : TStatusBar;
FNDigit : longint;
protected
procedure ShowProgress(R : real);
procedure Execute; override;
public
constructor Create(SB : TStatusBar; NDigit : longint; var Res : PChar);
end;
 
implementation
 
uses SysUtils;
 
procedure TCalc.ShowProgress(R : real);
begin
if R > 100 then R := 100;
FStatusBar.SimpleText := Format('%5.1f%s', [R, '% Done']);
end;
 
procedure TCalc.Execute;
const
NewLine = #13#10' ';
 
var
Pi, X1, X2, X3 : PLongInteger;
i, j, n, m, k1, k2 : longint;
All : real;
OldDecSeparator : char;
 
begin
OldDecSeparator := DecimalSeparator;
DecimalSeparator := '.';
 
NumDWord := Round((FNDigit + 40) / 2.3) div 4;
All := FNDigit * 1.47;
k1 := 0; k2 := 0;
 
GetMem(Pi, NumDWord * 4);
GetMem(X1, NumDWord * 4);
GetMem(X2, NumDWord * 4);
GetMem(X3, NumDWord * 4);
 
LetLong(X1^, 0);
LetLong(X2^, 1);
j := 0;
for i := 1 to FNDigit do begin
ShowProgress(i / All * 100);
if i = 1 then DivLongLim(X2^, 5, j)
else DivLongLim(X2^, 5*5, j);
 
MovLongLim(X2^, X3^, j);
DivLongLim(X3^, 2 * i - 1, j);
while (NumDWord - j div 4 - 1 > 0)
and (X2^[NumDWord - j div 4 - 1] = 0) do Inc(j, 4);
if NumDWord - j div 4 - 1 <= 0 then Break;
 
if i mod 2 = 1 then AddLongLim(X1^, X3^, j)
else SubLongLim(X1^, X3^, j);
 
if Terminated then begin
FreeMem(Pi, NumDWord * 4);
FreeMem(X1, NumDWord * 4);
FreeMem(X2, NumDWord * 4);
FreeMem(X3, NumDWord * 4);
Exit;
end;
k1 := i;
end;
MovLong(X1^, Pi^);
MulLong(Pi^, 16);
 
LetLong(X1^, 0);
LetLong(X2^, 1);
j := 0;
for i := 1 to FNDigit do begin
ShowProgress((i + k1) / All * 100);
if i = 1 then DivLongLim(X2^, 239, j)
else DivLongLim(X2^, 239*239, j);
 
MovLongLim(X2^, X3^, j);
DivLongLim(X3^, 2 * i - 1, j);
while (NumDWord - j div 4 - 1 > 0)
and (X2^[NumDWord - j div 4 - 1] = 0) do Inc(j, 4);
if NumDWord - j div 4 - 1 <= 0 then Break;
 
if i mod 2 = 1 then AddLongLim(X1^, X3^, j)
else SubLongLim(X1^, X3^, j);
 
if Terminated then begin
FreeMem(Pi, NumDWord * 4);
FreeMem(X1, NumDWord * 4);
FreeMem(X2, NumDWord * 4);
FreeMem(X3, NumDWord * 4);
Exit;
end;
k2 := i;
end;
MulLong(X1^, 4);
SubLong(Pi^, X1^);
 
i := NumDWord;
while (i > 0) and (Pi^[i] = 0) do Dec(i);
 
StrPCopy(FRes, IntToStr(Pi^[i]) + '.');
 
n := 0;
m := 2;
for j := FNDigit + i downto 1 do begin
ShowProgress((n/2 + k1 + k2) / All * 100);
if j <= 0 then Break;
 
Pi^[i] := 0;
MulLongLenLim(Pi^, 10, n div 3);
Inc(n, 1);
 
FRes[m] := Chr(Pi^[i] + Ord('0'));
Inc(m);
 
if n mod 50 = 0 then begin
Move(NewLine, FRes[m], 5);
Inc(m, 5);
end
else
if n mod 10 = 0 then begin
FRes[m] := ' ';
Inc(m);
end;
 
if (n + 2) > FNDigit then Break;
 
if Terminated then begin
FreeMem(Pi, NumDWord * 4);
FreeMem(X1, NumDWord * 4);
FreeMem(X2, NumDWord * 4);
FreeMem(X3, NumDWord * 4);
Exit;
end;
end;
FRes[m] := #0;
 
FreeMem(Pi, NumDWord * 4);
FreeMem(X1, NumDWord * 4);
FreeMem(X2, NumDWord * 4);
FreeMem(X3, NumDWord * 4);
 
DecimalSeparator := OldDecSeparator;
end;
 
constructor TCalc.Create;
begin
FStatusBar := SB;
FNDigit := NDigit + 1;
FRes := Res;
FreeOnTerminate := True;
inherited Create(False);
end;
 
end.
/Delphi/akPi/Source/ShowUnit.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Delphi/akPi/Source/akpi.dpr
0,0 → 1,32
// akPi v2.2
// Copyright (c) 1997-98 Anatoli Klassen
 
// Program to calculate Pi.
// It doesn't have any practical usage :)
// Maybe just to test computer speed or learn
// x86 assembler.
// Sure calculates right up to 100000 digits
// No guaranties
// Use it and its source code as you want.
 
// Uses formula pi = 16 * arctg(1/5) - 4 * arctg(1/239)
// where arctg x = x - x^3/3 + x^5/5 - x^7/7 + ...
 
program akPi;
 
uses
Forms,
ShowUnit in 'ShowUnit.pas' {ShowForm},
CalcUnit in 'CalcUnit.pas',
LongIntegerUnit in 'LongIntegerUnit.pas',
AboutUnit in 'AboutUnit.pas' {AboutBox};
 
{$R *.RES}
 
begin
Application.Initialize;
Application.Title := 'akPi';
Application.CreateForm(TShowForm, ShowForm);
Application.CreateForm(TAboutBox, AboutBox);
Application.Run;
end.
/Delphi/akPi/Source/akpi.dof
0,0 → 1,84
[FileVersion]
Version=6.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=0
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=..\Exe
UnitOutputDir=..\Units
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\Units
Packages=VCLX30;VCL30;VCLDB30;VCLDBX30;INETDB30;INET30;VCLSMP30;QRPT30;TEEUI30;TEEDB30;TEE30;DSS30;IBEVNT30
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=1
MajorVer=2
MinorVer=2
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252
[Version Info Keys]
CompanyName=Anatoli Klassen
FileDescription=akPi
FileVersion=2.2.0.0
InternalName=akPi
LegalCopyright=(c) 1997-2000 Anatoly Klassen
LegalTrademarks=
OriginalFilename=akpi.exe
ProductName=akPi
ProductVersion=2.2
Comments=freeware
Home Page=www.aksoft.net/progs/akpi
/Delphi/akPi/Source/readme.txt
0,0 → 1,14
There is source code of akPi (for Delphi 5).
You can download the program itself from
 
www.aksoft.net/progs/akpi
 
The program and its source code are provided
"AS IS", no any warranties.
 
You may use this source code in any way,
but please make a reference to me.
 
Feel free to ask me if you have any questions:
 
akpi@aksoft.net
/Delphi/akPi/Source/AboutUnit.pas
0,0 → 1,58
// akPi v2.2
// Copyright (c) 1997-99 Anatoli Klassen
 
unit AboutUnit;
 
interface
 
uses
WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, ShellAPI;
 
type
TAboutBox = class(TForm)
OkButton : TBitBtn;
ProgramIcon : TImage;
ProductName : TLabel;
Version : TLabel;
Copyright : TLabel;
WebLabel: TLabel;
MailLabel: TLabel;
HTMLLabel: TLabel;
MailtoLabel: TLabel;
procedure HTMLLabelClick(Sender: TObject);
procedure MailtoLabelClick(Sender: TObject);
private
public
end;
 
var
AboutBox : TAboutBox;
 
implementation
 
uses SysUtils;
 
{$R *.DFM}
 
procedure TAboutBox.HTMLLabelClick(Sender: TObject);
var
URL : string;
 
begin
if (Sender is TLabel) then begin
URL := (Sender as TLabel).Caption;
if UpperCase(Copy(URL, 1, 7)) <> 'HTTP://' then URL := 'http://' + URL;
 
ShellExecute(0, nil, PChar(URL), nil, nil, 0);
end;
end;
 
procedure TAboutBox.MailtoLabelClick(Sender: TObject);
begin
ShellExecute(0, nil, PChar('mailto:' + MailtoLabel.Caption), nil, nil, 0);
end;
 
end.
 
 
/Delphi/akPi/Source/akpi.res
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Delphi/akPi/Source/akPi.ico
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Delphi/akPi/Source/AboutUnit.dfm
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
Property changes:
Added: svn:mime-type
+application/octet-stream
\ No newline at end of property
/Delphi/akPi/Source/LongIntegerUnit.pas
0,0 → 1,332
// akPi v2.2
// Copyright (c) 1997-98 Anatoli Klassen
 
unit LongIntegerUnit;
 
interface
 
const
MaxLongDigit = 100040 div 4;
NumDWord : longint = MaxLongDigit div 4;
 
type
PLongInteger = ^LongInteger;
LongInteger = array[1..MaxLongDigit] of Cardinal;
 
procedure MovLong(var A, B : LongInteger); { B := A }
procedure LetLong(var A : LongInteger; B : longint); { A := B }
procedure AddLong(var A, B : LongInteger); { A := A + B }
procedure SubLong(var A, B : LongInteger); { A := A - B }
procedure MulLong(var A : LongInteger; B : longint); { A := A * B }
procedure DivLong(var A : LongInteger; B : longint); { A := A div B }
 
procedure MovLongLim(var A, B : LongInteger; Lim : longint); { B := A }
procedure AddLongLim(var A, B : LongInteger; Lim : longint); { A := A + B }
procedure SubLongLim(var A, B : LongInteger; Lim : longint); { A := A - B }
procedure MulLongLim(var A : LongInteger; B, Lim : longint); { A := A * B }
procedure DivLongLim(var A : LongInteger; B, Lim : longint); { A := A div B }
 
procedure MulLongLenLim(var A : LongInteger; B, Lim : longint); { A := A * B }
 
// (Lim - in bytes)
 
implementation
 
procedure MovLong(var A, B : LongInteger); { B := A }
asm
PUSHAD
PUSHF
 
MOV ESI,A
MOV EDI,B
 
MOV ECX,NumDWord
CLD
REP MOVSD
 
POPF
POPAD
end;
 
procedure LetLong(var A : LongInteger; B : longint); { A := B }
asm
PUSHAD
PUSHF
MOV EDI,A
 
CLD
MOV ECX,NumDWord
DEC ECX
MOV EAX,0
REP STOSD
 
MOV EAX,B
MOV [EDI],EAX
 
POPF
POPAD
end;
 
procedure AddLong(var A, B : LongInteger); { A := A + B }
asm
PUSHAD
PUSHF
MOV ESI,A
MOV EDI,B
 
MOV ECX,NumDWord
MOV EBX,0
CLC
 
@ADDL:
MOV EAX,[EDI+EBX*4]
ADC [ESI+EBX*4],EAX
INC EBX
DEC ECX
JNZ @ADDL
 
POPF
POPAD
end;
 
procedure SubLong(var A, B : LongInteger); { A := A - B }
asm
PUSHAD
PUSHF
MOV ESI,A
MOV EDI,B
 
MOV ECX,NumDWord
MOV EBX,0
CLC
 
@SUBL:
MOV EAX,[EDI+EBX*4]
SBB [ESI+EBX*4],EAX
INC EBX
DEC ECX
JNZ @SUBL
 
POPF
POPAD
end;
 
procedure MulLong(var A : LongInteger; B : longint); { A := A * B }
asm
PUSHAD
PUSHF
MOV EDI,A
 
MOV ECX,NumDWord
MOV EBX,B
MOV EBP,0
CLD
 
@MULL:
MOV EAX,[EDI]
MUL EBX
ADD EAX,EBP
MOV EBP,EDX
STOSD
DEC ECX
JNZ @MULL
 
POPF
POPAD
end;
 
procedure DivLong(var A : LongInteger; B : longint); { A := A div B }
asm
PUSHAD
PUSHF
MOV EDI,A
MOV EBX,B
 
MOV ECX,NumDWord { EDX := A + NumDWord * 4 - 4 }
MOV EDX,ECX
SHL EDX,2
SUB EDX,4
ADD EDI,EDX
 
MOV EDX,0
STD
 
@DIVL:
MOV EAX,[EDI]
DIV EBX
STOSD
DEC ECX
JNZ @DIVL
CLD
 
POPF
POPAD
end;
 
//===========================================================================
 
procedure MovLongLim; { B := A }
asm
PUSHAD
PUSHF
 
MOV ESI,A
MOV EDI,B
MOV EAX,Lim
SHR EAX,2
 
MOV ECX,NumDWord
SUB ECX,EAX
CLD
REP MOVSD
 
POPF
POPAD
end;
 
procedure AddLongLim; { A := A + B }
asm
PUSHAD
PUSHF
MOV ESI,A
MOV EDI,B
MOV EAX,Lim
SHR EAX,2
 
MOV ECX,NumDWord
SUB ECX,EAX
MOV EBX,0
CLC
 
@ADDL:
MOV EAX,[EDI+EBX*4]
ADC [ESI+EBX*4],EAX
INC EBX
DEC ECX
JNZ @ADDL
JC @ADDL
 
POPF
POPAD
end;
 
procedure SubLongLim; { A := A - B }
asm
PUSHAD
PUSHF
MOV ESI,A
MOV EDI,B
MOV EAX,Lim
SHR EAX,2
 
MOV ECX,NumDWord
SUB ECX,EAX
MOV EBX,0
CLC
 
@SUBL:
MOV EAX,[EDI+EBX*4]
SBB [ESI+EBX*4],EAX
INC EBX
DEC ECX
JNZ @SUBL
JC @SUBL
 
POPF
POPAD
end;
 
procedure MulLongLim; { A := A * B }
asm
PUSHAD
PUSHF
MOV EDI,A
MOV EBX,B
MOV EAX,Lim
SHR EAX,2
 
MOV ECX,NumDWord
SUB ECX,EAX
MOV EBP,0
CLD
 
@MULL:
MOV EAX,[EDI]
MUL EBX
ADD EAX,EBP
MOV EBP,EDX
STOSD
DEC ECX
JNZ @MULL
JC @MULL
 
POPF
POPAD
end;
 
procedure DivLongLim; { A := A div B }
asm
PUSHAD
PUSHF
MOV EDI,A
MOV EBX,B
MOV EAX,Lim
SHR EAX,2
 
MOV ECX,NumDWord
SUB ECX,EAX
MOV EDX,ECX { EDI := A + NumDWord * 4 - 4 }
SHL EDX,2
SUB EDX,4
ADD EDI,EDX
 
MOV EDX,0
STD
 
@DIVL:
MOV EAX,[EDI]
DIV EBX
STOSD
DEC ECX
JNZ @DIVL
CLD
 
POPF
POPAD
end;
 
//===========================================================================
 
procedure MulLongLenLim; { A := A * B }
asm
PUSHAD
PUSHF
MOV EDI,A
MOV EBX,B
MOV EAX,Lim
SHR EAX,2
 
MOV ECX,NumDWord
SUB ECX,EAX
SHL EAX,2
ADD EDI,EAX
 
MOV EBP,0
CLD
 
@MULL:
MOV EAX,[EDI]
MUL EBX
ADD EAX,EBP
MOV EBP,EDX
STOSD
DEC ECX
JNZ @MULL
JC @MULL
 
POPF
POPAD
end;
 
end.
 
/Delphi/akPi/Source/ShowUnit.pas
0,0 → 1,188
// akPi v2.2
// Copyright (c) 1997-99 Anatoli Klassen
 
unit ShowUnit;
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, LongIntegerUnit, ExtCtrls, Menus;
 
type
TShowForm = class(TForm)
NumberLabel : TLabel;
NumberEdit : TEdit;
StatusBar : TStatusBar;
StartButton : TButton;
ResultBox : TGroupBox;
CancelButton : TButton;
AboutButton : TButton;
ExitButton : TButton;
ResultPopupMenu : TPopupMenu;
CopyItem : TMenuItem;
CopyAllItem : TMenuItem;
SaveItem : TMenuItem;
BreakLine : TMenuItem;
SaveDialog : TSaveDialog;
ResultText : TRichEdit;
HelpButton: TButton;
procedure StartButtonClick (Sender : TObject);
procedure CancelButtonClick(Sender : TObject);
procedure AboutButtonClick (Sender : TObject);
procedure ExitButtonClick (Sender : TObject);
procedure CopyItemClick (Sender : TObject);
procedure CopyAllItemClick (Sender : TObject);
procedure SaveItemClick (Sender : TObject);
procedure FormCreate(Sender: TObject);
procedure HelpButtonClick(Sender: TObject);
private
CalcThread : TThread;
NDigit : longint;
StartTime : TDateTime;
Canceled : boolean;
Pi : PChar;
FCalcTime : string;
procedure ThreadDone(Sender : TObject);
function CalcTime : string;
procedure ChangeMenuState(State : boolean);
public
end;
 
var
ShowForm : TShowForm;
 
implementation
 
uses CalcUnit, AboutUnit, ClipBrd;
 
{$R *.DFM}
 
procedure TShowForm.ThreadDone(Sender : TObject);
begin
StartButton.Visible := True;
CancelButton.Visible := False;
NumberEdit.Enabled := True;
NumberEdit.SetFocus;
 
if Canceled then StatusBar.SimpleText := 'Calculations is aborted'
else begin
StatusBar.SimpleText := 'Time of calculations: ' + CalcTime;
ResultText.Text := Pi;
FreeMem(Pi, Round(NDigit * 1.5));
ChangeMenuState(True);
end;
end;
 
procedure TShowForm.StartButtonClick(Sender : TObject);
begin
NDigit := StrToIntDef(NumberEdit.Text, 100);
if NDigit < 100 then NDigit := 100;
if NDigit > MaxLongDigit * 4 - 40 then NDigit := MaxLongDigit * 4 - 40;
NumberEdit.Text := IntToStr(NDigit);
 
Canceled := False;
StartTime := Now;
StartButton.Visible := False;
CancelButton.Visible := True;
NumberEdit.Enabled := False;
ChangeMenuState(False);
 
ResultText.Lines.Clear;
 
GetMem(Pi, Round(NDigit * 1.5));
CalcThread := TCalc.Create(StatusBar, NDigit, Pi);
CalcThread.OnTerminate := ThreadDone;
end;
 
procedure TShowForm.CancelButtonClick(Sender : TObject);
begin
Canceled := True;
CalcThread.Terminate;
end;
 
procedure TShowForm.AboutButtonClick(Sender : TObject);
begin
AboutBox.ShowModal;
end;
 
function TShowForm.CalcTime;
var
StopTime : TDateTime;
S : string;
 
begin
StopTime := Now - StartTime;
Result := TimeToStr(StopTime);
if Int(StopTime) > 0 then begin
S := Copy(Result, 1, Pos(':', Result) - 1);
Delete(Result, 1, Pos(':', Result) - 1);
Result := IntToStr(Trunc(StopTime) * 24 + StrToInt(S)) + Result;
end;
FCalcTime := Result;
end;
 
procedure TShowForm.ExitButtonClick(Sender : TObject);
begin
Close;
end;
 
procedure TShowForm.CopyItemClick(Sender : TObject);
begin
ResultText.CopyToClipboard;
end;
 
procedure TShowForm.CopyAllItemClick(Sender : TObject);
begin
Clipboard.AsText := ResultText.Lines.Text;
end;
 
procedure TShowForm.SaveItemClick(Sender : TObject);
var
i : longint;
S : TStringList;
st : string;
 
begin
if SaveDialog.Execute then begin
S := TStringList.Create;
 
for i := 0 to ResultText.Lines.Count - 1 do begin
st := ResultText.Lines[i];
if st[1] = ' ' then Delete(st, 1, 1);
S.Add(st);
end;
S.Add(FCalcTime);
 
S.SaveToFile(SaveDialog.FileName);
S.Free;
end;
end;
 
procedure TShowForm.ChangeMenuState(State : boolean);
begin
CopyItem.Enabled := State;
CopyAllItem.Enabled := State;
SaveItem.Enabled := State;
end;
 
function AddBackslash(const Path : string) : string;
begin
if Path = '' then Result := Path
else
if Path[Length(Path)] = '\' then Result := Path
else Result := Path + '\';
end;
 
procedure TShowForm.FormCreate(Sender: TObject);
begin
Application.HelpFile :=
AddBackslash(ExtractFileDir(Application.ExeName)) + 'akpi.hlp';
end;
 
procedure TShowForm.HelpButtonClick(Sender: TObject);
begin
Application.HelpContext(1);
end;
 
end.
/Delphi/akPi/Source/akpi.cfg
0,0 → 1,39
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$Y-
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-E"..\Exe"
-N"..\Units"
-U"..\Units"
-O"..\Units"
-I"..\Units"
-R"..\Units"