How can I calculate the square root of a number in Inno Setup?
After studying a bit the field of mathematics, could do the calculation.
//Sqtr calc
Function SqtrCalc(n : Single) : Single;
Var
I: Integer;
y: Single;
Begin
y := n;
for I := 0 to 9 do
begin
y := y / 2 + n / (2 * y);
end;
Result := y;
End;
Related
Well I have to generate 10 random radiuses and then draw circles. But I'm not sure how to calculate X coordinate so they will be contigous. I got this code but it doesn't work properly
uses graphabc;
var
a: array [1..10] of integer;
i, x, y, r, rn: integer;
begin
i:=1;
while (i < 11) do begin
rn:= random(5,50);
a[i]:=rn;
i:=i+1;
end;
r:=a[1];
y:=300;
x:=100;
for i:=1 to 10 do begin
circle(x, y, r);
r:=a[i];
x:=x+r;
end;
end.
To make two circles to touch each other, distance between centers must be sum of both radiuses. Simple correction (remove if i > 1 if shift is needed):
for i:=1 to 10 do begin
r:=a[i];
if i > 1 then
x:=x+r;
circle(x, y, r);
x:=x+r;
end;
end.
Let's say we have this Integer 1234567890, we want it converted to a string with a separator = 1.234.567.890, we could do Format('%n',[1234567890.0]); but it's very slow. I wrote a function to speed it up considerably (more than 2x faster). How could I improve it further, or can you come up with a faster routine?
function MyConvertDecToStrWithDot(Const n: UInt64): string;
Var a,b,x: Integer;
z,step: Integer;
l: SmallInt;
begin
Result := IntToStr(n);
if n < 1000 then Exit;
l := Length(Result);
a := l div 3;
b := l mod 3;
step := b+1;
z := 4;
if b <> 0 then begin
Insert('.',Result,step);
Inc(z,step);
end;
for x := 1 to (a-1) do begin
Insert('.',Result,z);
Inc(z,4);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
Var a: Integer;
s: string;
begin
PerfTimerInit;
for a := 1 to 1000000 do
s := MyConvertDecToStrWithDot(1234567890);
Memo1.lines.Add(PerfTimerStopMS.ToString);
caption := s;
end;
32-bit
Format: ~230ms
My function: ~79ms
64-bit
Format: ~440ms
My function: ~103ms
In my tests, the following is ever so slightly faster:
function ThousandsSepStringOf(Num: UInt64): string;
const
MaxChar = 30; // Probably, 26 is enough: 19 digits + 7 separators
var
Count: Integer;
Rem: UInt64;
Res: array[0..MaxChar] of Char;
WritePtr: PChar;
begin
WritePtr := #Res[MaxChar];
WritePtr^ := #0;
Count := 0;
while Num > 0 do
begin
DivMod(Num, 10, Num, Rem);
Dec(WritePtr);
WritePtr^ := Char(Byte(Rem) + Ord('0'));
Inc(Count);
if Count = 3 then
begin
Dec(WritePtr);
WritePtr^ := '.';
Count := 0;
end;
end;
if WritePtr^ = '.' then
Inc(WritePtr);
Count := MaxChar - ((NativeInt(WritePtr) - NativeInt(#Res)) shr 1);
SetLength(Result, Count);
Move(WritePtr^, PByte(Result)^, Count * SizeOf(Char));
end;
Tested with:
procedure TestHisCode;
Var
a: Integer;
s: string;
SW: TStopwatch;
begin
Writeln('His code');
SW := TStopwatch.StartNew;
for a := 1 to KLoops do
s := MyConvertDecToStrWithDot(1234567890);
Writeln(SW.ElapsedMilliseconds);
Writeln(s);
Writeln;
end;
procedure TestMyCode;
Var
a: Integer;
s: string;
SW: TStopwatch;
begin
Writeln('My code');
SW := TStopwatch.StartNew;
for a := 1 to KLoops do
s := ThousandsSepStringOf(1234567890);
Writeln(SW.ElapsedMilliseconds);
Writeln(s);
Writeln;
end;
and:
TestHisCode;
TestMyCode;
TestMyCode;
TestHisCode;
TestMyCode;
TestHisCode;
TestHisCode;
TestMyCode;
Haven't properly tested the performance of this, however it should be cross-platform and locale independent:
function Thousands(const ASource: string): string;
var
I, LLast: Integer;
begin
Result := ASource;
LLast := Length(Result);
I := LLast;
while I > 0 do
begin
if (LLast - I + 1) mod 3 = 0 then
begin
Insert(FormatSettings.ThousandSeparator, Result, I);
Dec(I, 2);
end
else
Dec(I);
end;
end;
Note: It obviously just works on integers
It's better to insert the separators directly while constructing the string instead of inserting separators later into the converted string because each insertion involves a lot of data movements and performance degradation. Besides avoid the division by 3 may improve performance a bit
This is what I get from my rusty Pascal after decades not using it
uses strutils;
function FormatNumber(n: integer): string;
var digit: integer;
count: integer;
isNegative: boolean;
begin
isNegative := (n < 0);
if isNegative then n := -n;
Result := '';
count := 3;
while n <> 0 do begin
digit := n mod 10;
n := n div 10;
if count = 0 then begin
Result := Result + '.';
count := 3;
end;
Result := Result + chr(ord('0') + digit);
dec(count);
end;
if isNegative then Result := Result + '-';
Result := reversestring(Result);
end;
See it in action: http://ideone.com/6O3e8w
It's also faster to just assign the characters directly instead of using concatenation operator/function like Victoria suggested. This is the improved version with only unsigned types
type string28 = string[28];
function FormatNumber(n: UInt64): string28;
var digit: integer;
length: integer;
count: integer;
c: char;
begin
count := 3;
length := 0;
while n <> 0 do begin
digit := n mod 10;
n := n div 10;
if count = 0 then begin
inc(length);
Result[length] := '.';
count := 3;
end;
inc(length);
Result[length] := chr(ord('0') + digit);
dec(count);
end;
for count := 1 to (length + 1) div 2 do begin
c := Result[count];
Result[count] := Result[length - count + 1];
Result[length - count + 1] := c;
end;
setlength(Result, length);
FormatNumber := Result;
end;
If the operation is done millions of times and is really a bottleneck after profiling, it's better to do in multiple threads along with SIMD
I need to make color of my Status Bar (it is a TPanel) change (Lighten or Darken) automatically according to user's current System Specifications which is displayed in my wpInfoBefore Wizard Page.
I like to have two functions which can do this correctly by inputting a TColor as Value. But , I tried many times to write those functions by reading posts like this , even using RGB function, but with no success.
For Example, If I need to darken or lighten the given TColor, I may need to use functions like shown below:
var
RecommendedStatusColor: TColor;
function LightenColor(Colour: TColor, Percentage: Integer): TColor;
begin
...
end;
function DarkenColor(Colour: TColor, Percentage: Integer): TColor;
begin
...
end;
RecommendedStatusColor := $00D000;
if ... then
StatusBar.Color := LightenColor(RecommendedStatusColor, 75);
//Lighten given color by 75%
if ... then
StatusBar.Color := DarkenColor(RecommendedStatusColor, 50);
//Darken given color by 50%
Output should be the modified (Lightened or Darkened) TColor.
Thanks in Advance.
You have to convert the color to HSL or HSV and change the lightness (L) or value (V) and convert back to RGB.
The following code uses the HSL (L = lightness).
function GetRValue(RGB: Cardinal): Byte;
begin
Result := Byte(rgb);
end;
function GetGValue(RGB: Cardinal): Byte;
begin
Result := Byte(rgb shr 8);
end;
function GetBValue(RGB: Cardinal): Byte;
begin
Result := Byte(rgb shr 16);
end;
function Max(A, B: Integer): Integer;
begin
if A > B then
Result := A
else
Result := B;
end;
function Min(A, B: Integer): Integer;
begin
if A < B then
Result := A
else
Result := B;
end;
const
HLSMAX = 240;
RGBMAX = 255;
HLSUndefined = (HLSMAX*2/3);
procedure ColorRGBToHLS(RGB: Cardinal; var Hue, Luminance, Saturation: Word);
var
H, L, S: Double;
R, G, B: Word;
cMax, cMin: Double;
Rdelta, Gdelta, Bdelta: Word; { intermediate value: % of spread from max }
begin
R := GetRValue(RGB);
G := GetGValue(RGB);
B := GetBValue(RGB);
{ calculate lightness }
cMax := Max(Max(R, G), B);
cMin := Min(Min(R, G), B);
L := ( ((cMax + cMin) * HLSMAX) + RGBMAX ) / ( 2 * RGBMAX);
Luminance := Trunc(L);
if cMax = cMin then { r=g=b --> achromatic case }
begin
Hue := Trunc(HLSUndefined);
Saturation := 0;
end
else { chromatic case }
begin
{ saturation }
if Luminance <= HLSMAX/2 then
begin
S := ( ((cMax-cMin)*HLSMAX) + ((cMax+cMin)/2) ) / (cMax+cMin);
end
else
begin
S := ( ((cMax-cMin)*HLSMAX) + ((2*RGBMAX-cMax-cMin)/2) ) /
(2*RGBMAX-cMax-cMin);
end;
{ hue }
Rdelta := Trunc(( ((cMax-R)*(HLSMAX/6)) + ((cMax-cMin)/2) ) / (cMax-cMin));
Gdelta := Trunc(( ((cMax-G)*(HLSMAX/6)) + ((cMax-cMin)/2) ) / (cMax-cMin));
Bdelta := Trunc(( ((cMax-B)*(HLSMAX/6)) + ((cMax-cMin)/2) ) / (cMax-cMin));
if (Double(R) = cMax) then
begin
H := Bdelta - Gdelta
end
else if (Double(G) = cMax) then
begin
H := (HLSMAX/3) + Rdelta - Bdelta
end
else // B == cMax
begin
H := ((2 * HLSMAX) / 3) + Gdelta - Rdelta;
end;
if (H < 0) then
H := H + HLSMAX;
if (H > HLSMAX) then
H := H - HLSMAX;
Hue := Round(H);
Saturation := Trunc(S);
end;
end;
function HueToRGB(Lum, Sat, Hue: Double): Integer;
var
ResultEx: Double;
begin
{ range check: note values passed add/subtract thirds of range }
if (hue < 0) then
hue := hue + HLSMAX;
if (hue > HLSMAX) then
hue := hue - HLSMAX;
{ return r,g, or b value from this tridrant }
if (hue < (HLSMAX/6)) then
ResultEx := Lum + (((Sat-Lum)*hue+(HLSMAX/12))/(HLSMAX/6))
else if (hue < (HLSMAX/2)) then
ResultEx := Sat
else if (hue < ((HLSMAX*2)/3)) then
ResultEx := Lum + (((Sat-Lum)*(((HLSMAX*2)/3)-hue)+(HLSMAX/12))/(HLSMAX/6))
else
ResultEx := Lum;
Result := Round(ResultEx);
end;
function RoundColor(Value: Double): Integer;
begin
if Value > 255 then
Result := 255
else
Result := Round(Value);
end;
function RGB(R, G, B: Byte): Cardinal;
begin
Result := (Cardinal(R) or (Cardinal(G) shl 8) or (Cardinal(B) shl 16));
end;
function ColorHLSToRGB(Hue, Luminance, Saturation: Word): Cardinal;
var
R,G,B: Double; { RGB component values }
Magic1,Magic2: Double; { calculated magic numbers (really!) }
begin
if (Saturation = 0) then
begin { achromatic case }
R := (Luminance * RGBMAX)/HLSMAX;
G := R;
B := R;
if (Hue <> HLSUndefined) then
;{ ERROR }
end
else
begin { chromatic case }
{ set up magic numbers }
if (Luminance <= (HLSMAX/2)) then
begin
Magic2 := (Luminance * (HLSMAX + Saturation) + (HLSMAX/2)) / HLSMAX;
end
else
begin
Magic2 :=
Luminance + Saturation - ((Luminance * Saturation) +
(HLSMAX/2)) / HLSMAX;
end;
Magic1 := 2 * Luminance - Magic2;
{ get RGB, change units from HLSMAX to RGBMAX }
R := (HueToRGB(Magic1,Magic2,Hue+(HLSMAX/3))*RGBMAX + (HLSMAX/2))/HLSMAX;
G := (HueToRGB(Magic1,Magic2,Hue)*RGBMAX + (HLSMAX/2)) / HLSMAX;
B := (HueToRGB(Magic1,Magic2,Hue-(HLSMAX/3))*RGBMAX + (HLSMAX/2))/HLSMAX;
end;
Result := RGB(RoundColor(R), RoundColor(G), RoundColor(B));
end;
function LightenColor(RGB: Cardinal; Percentage: Integer): Cardinal;
var
H, S, L: Word;
begin
ColorRGBToHLS(RGB, H, L, S);
L := (Cardinal(L) * Percentage) div 100;
Result := ColorHLSToRGB(H, L, S);
end;
function GetSysColor(nIndex: Integer): DWORD;
external 'GetSysColor#User32.dll stdcall';
function ColorToRGB(Color: TColor): Cardinal;
begin
if Color < 0 then
Result := GetSysColor(Color and $000000FF) else
Result := Color;
end;
Usage:
LighterColor := TColor(LightenColor(ColorToRGB(Color), 150));
DarkerColor := TColor(LightenColor(ColorToRGB(Color), 75));
References:
ColorRGBToHLS + ColorHLSToRGB – VCL source code
Min + Max – Inno Setup get Min and Max Integer values in Pascal Script
ColorToRGB – Converting Inno Setup WizardForm.Color to RGB
LightenColor – Lighten colors programmatically with Delphi
I have tried to write a parallel threading example using AsyncCalls and the following is to parallel compute the number of prime numbers
program Project3;
{$APPTYPE CONSOLE}
uses
SysUtils,
Math,
Windows,
AsyncCalls in 'AsyncCalls.pas';
const
N = 1000000;
MAXT = 100;
var
threads : array of IAsyncCall;
ans: array of integer;
cnt: DWORD;
i, v, j, k, portion: integer;
function IsPrime(x: integer): boolean;
var
i: integer;
begin
if (x <= 1) then
begin
Result := False;
Exit;
end;
if (x = 2) then
begin
Result := True;
Exit;
end;
for i:= 2 to Ceil(Sqrt(x))do
begin
if (x mod i = 0) then
begin
Result := False;
Exit;
end;
end;
Result := True;
end;
procedure DoWork(left, right: integer; value: PInteger); cdecl;
var
i, cnt: integer;
begin
cnt := 0;
for i := left to right do
begin
if (IsPrime(i)) then
begin
Inc(cnt);
end;
end;
value^ := cnt;
end;
begin
// Paralell
cnt := GetTickCount;
SetLength(ans, MAXT);
SetLength(threads, MAXT);
portion := N div MAXT;
for i := 0 to MAXT - 2 do
begin
// left index
j := i * portion;
// right index
k := (i + 1) * portion - 1;
threads[i] := AsyncCall(#DoWork, [j, k, #ans[i]]);
end;
// last thread
j := (MAXT - 1) * portion;
threads[MAXT - 1] := AsyncCall(#DoWork, [j, N - 1, #ans[MAXT - 1]]);
// Join, doesn't seem to wait all
AsyncMultiSync(threads, True, INFINITE);
// ****Adding a delay to wait for all threads*****
// Sleep(1000);
// Sum the answer
v := 0;
for i := 0 to MAXT - 1 do
begin
Inc(v, ans[i]);
end;
Writeln('Parallel = ', GetTickCount - cnt);
Writeln('Answer = ', v);
// Serial
cnt := GetTickCount;
DoWork(0, N - 1, #v);
Writeln('Serial = ', GetTickCount - cnt);
Writeln('Answer = ', v);
Readln;
end.
Strange behaviour. The AsyncMultiSync does not seem waiting at all. If I do not add Sleep(1000), the output is
Parallel = 172
Answer = 0
Serial = 453
Answer = 78498
If I add Sleep(1000), the output is correct:
Parallel = 1188
Answer = 78498
Serial = 265
Answer = 78498
I tried using threads[i].Sync, and it produces similar results.
Did I miss something here?
The environment is D2007, Windows 10 64-bit Home
Documentation says not to exceed the maximum number of wait objects, 61.
So you will have to reduce the MaxT constant.
I am trying to use multithreading in Delphi XE.
The task is following I have to create 4 threads. Each thread draw colored circle in Paintbox at predefined area, For example FIRST thread draw only red circles in first quoter of the Paintbox, the SECOND thread draw only yellow circles in the second quoter, and so on.
I have defined following class
const
NumberOfIterations = 100000;
NumberOfTreads = 4;
TCalcThread = class(TThread)
private
FIdx: Integer;
FHits: Cardinal;
V: array of Integer;
xPaintBox1: TPaintBox;
protected
procedure Execute; override;
public
constructor Create(Idx: Integer; vPaintBox: TPaintBox);
property Hits: Cardinal read FHits;
end;
In main code I do the following:
procedure TForm11.Button1Click(Sender: TObject);
var
thrarr: array[0..NumberOfTreads - 1] of TCalcThread;
hndarr: array[0..NumberOfTreads - 1] of THandle;
i, a, t: Integer;
x, y: Integer;
begin
caption := '';
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.fillrect(PaintBox1.Canvas.ClipRect);
for i := 0 to NumberOfTreads - 1 do
begin
thrarr[i] := TCalcThread.Create(i, PaintBox1);
hndarr[i] := thrarr[i].Handle;
end;
WaitForMultipleObjects(NumberOfTreads, #hndarr, True, INFINITE);
for i := 0 to NumberOfTreads - 1 do
thrarr[i].Free;
end;
The thread Create and Execute methods are defined as following:
constructor TCalcThread.Create(Idx: Integer; vPaintBox: TPaintBox);
begin
FIdx := Idx;
FHits := 0;
xPaintBox1 := vPaintBox;
case FIdx of
0: xPaintBox1.Canvas.Pen.Color := clRed;
1: xPaintBox1.Canvas.Pen.Color := clYellow;
2: xPaintBox1.Canvas.Pen.Color := clBlue;
3: xPaintBox1.Canvas.Pen.Color := clMoneyGreen;
end;
xPaintBox1.Canvas.Brush.Color := xPaintBox1.Canvas.Pen.Color;
inherited Create(False);
end;
procedure TCalcThread.Execute;
var
i, start, finish: Integer;
x, y: Integer;
begin
start := (NumberOfIterations div NumberOfTreads) * FIdx;
finish := start + (NumberOfIterations div NumberOfTreads) - 1;
for i := start to finish do
begin
case FIdx of
0: begin
x := Random(200) + 1;
end;
1: begin
x := Random(200) + 201;
end;
2: begin
x := Random(200) + 401;
end;
3: begin
x := Random(200) + 601;
end;
end;
y := Random((xPaintBox1.height )) + 1;
xPaintBox1.Canvas.Ellipse(X - 5, Y - 5, X + 5, Y + 5);
end;
end;
As a result I am getting a few circles in three areas with the same color, and a lot of circles in one area (the same color). What I am doing wrong?