|
- unit utsUtils;
-
- {$IFDEF FPC}
- {$mode objfpc}{$H+}
- {$ENDIF}
-
- interface
-
- uses
- Classes, SysUtils, Contnrs,
- utsTypes;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TtsRefManager = class(TObject)
- private
- fMasterRef: TtsRefManager; // master of this object (master will destroy this object)
- fSlaveRefs: TObjectList; // slaves of this object (will destroy all slaves when this objects is destroyed)
- protected
- procedure AddSlave(const aSlave: TtsRefManager); virtual;
- function DelSlave(const aSlave: TtsRefManager): Boolean; virtual;
- public
- constructor Create(const aMaster: TtsRefManager);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TtsMultiMasterRefManager = class(TtsRefManager)
- private
- fMasterRefs: TObjectList;
- public
- procedure AddMaster(const aMaster: TtsRefManager); virtual;
- procedure DelMaster(const aMaster: TtsRefManager); virtual;
-
- constructor Create(const aMaster: TtsRefManager);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TtsKernel1DItem = packed record
- Offset: Integer;
- Value: Single;
- end;
-
- TtsKernel1D = class
- public
- Size: Integer;
- Items: array of TtsKernel1DItem;
- ItemCount: Integer;
- constructor Create(const aRadius, aStrength: Single);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TtsKernel2DItem = packed record
- OffsetX: Integer;
- OffsetY: Integer;
- Value: Double;
- DataOffset: Integer;
- end;
-
- TtsKernel2D = class
- public
- SizeX: Integer;
- SizeY: Integer;
-
- MidSizeX: Integer;
- MidSizeY: Integer;
-
- ValueSum: Double;
-
- Items: array of TtsKernel2DItem;
- ItemCount: Integer;
-
- constructor Create(const aRadius, aStrength: Single);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- EtsException = class(Exception);
- EtsRenderer = class(EtsException);
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsColor4f(r, g, b, a: Single): TtsColor4f;
- function tsPosition(const x, y: Integer): TtsPosition;
- function tsRect(const l, t, r, b: Integer): TtsRect; overload;
- function tsRect(const aTopLeft, aBottomRight: TtsPosition): TtsRect; overload;
- function tsVector4f(X, Y, Z, W: Single): TtsVector4f;
- function tsMatrix4f(X, Y, Z, P: TtsVector4f): TtsMatrix4f;
-
- function tsFormatSize(const aFormat: TtsFormat): Integer;
- procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f);
- procedure tsFormatUnmap(const aFormat: TtsFormat; var aData: PByte; out aColor: TtsColor4f);
-
- function tsBlendValueIgnore(const aSrc, aDst: Single): Single;
- function tsBlendValueReplace(const aSrc, aDst: Single): Single;
- function tsBlendValueModulate(const aSrc, aDst: Single): Single;
-
- function tsBlendColorAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
- function tsBlendColorAdditive(const aSrc, aDst: TtsColor4f): TtsColor4f;
- function tsBlendColorAdditiveAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
-
- function tsStrAlloc(aSize: Cardinal): PWideChar;
- function tsStrNew(const aText: PWideChar): PWideChar;
- procedure tsStrDispose(const aText: PWideChar);
- function tsStrLength(aText: PWideChar): Cardinal;
- function tsStrCopy(aDst, aSrc: PWideChar): PWideChar;
-
- function tsAnsiToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
- function tsISO_8859_1ToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar): Integer;
- function tsUTF8ToWide(aDst: PWideChar; const aSize: Integer; const aSrc: PAnsiChar; const aDefaultChar: WideChar): Integer;
- function tsUTFBE16ToWide(aDst: PWideChar; const aDstSize: Integer; aSrc: PByte; aSrcSize: Integer; const aDefaultChar: WideChar): Integer;
- function tsAnsiSBCDToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar; const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
-
- implementation
-
- uses
- math,
- utsConstants;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TtsRefManager/////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsRefManager.AddSlave(const aSlave: TtsRefManager);
- begin
- if Assigned(fSlaveRefs) then
- fSlaveRefs.Add(aSlave);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TtsRefManager.DelSlave(const aSlave: TtsRefManager): Boolean;
- begin
- result := false;
- if Assigned(fSlaveRefs) then
- result := (fSlaveRefs.Remove(aSlave) >= 0);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TtsRefManager.Create(const aMaster: TtsRefManager);
- begin
- inherited Create;
- fMasterRef := aMaster;
- fSlaveRefs := TObjectList.Create(false);
- if Assigned(fMasterRef) then
- fMasterRef.AddSlave(self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TtsRefManager.Destroy;
- var
- m: TtsRefManager;
- begin
- fSlaveRefs.OwnsObjects := true;
- FreeAndNil(fSlaveRefs);
- m := fMasterRef;
- fMasterRef := nil;
- if Assigned(m) then
- m.DelSlave(self);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TtsMultiMasterRefManager//////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsMultiMasterRefManager.AddMaster(const aMaster: TtsRefManager);
- begin
- if Assigned(fMasterRefs) then begin
- fMasterRefs.Add(aMaster);
- aMaster.AddSlave(self);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TtsMultiMasterRefManager.DelMaster(const aMaster: TtsRefManager);
- begin
- if Assigned(fMasterRefs) then begin
- if (fMasterRefs.Remove(aMaster) >= 0) then
- aMaster.DelSlave(self);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TtsMultiMasterRefManager.Create(const aMaster: TtsRefManager);
- begin
- inherited Create(aMaster);
- fMasterRefs := TObjectList.Create(false);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TtsMultiMasterRefManager.Destroy;
- var
- i: Integer;
- m: TObjectList;
- begin
- m := fMasterRefs;
- try
- fMasterRefs := nil;
- for i := m.Count-1 downto 0 do
- (m[i] as TtsRefManager).DelSlave(self);
- finally
- FreeAndNil(m);
- end;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Helper Methods////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsColor4f(r, g, b, a: Single): TtsColor4f;
- begin
- result.r := r;
- result.g := g;
- result.b := b;
- result.a := a;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsPosition(const x, y: Integer): TtsPosition;
- begin
- result.x := x;
- result.y := y;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsRect(const l, t, r, b: Integer): TtsRect;
- begin
- result.Left := l;
- result.Top := t;
- result.Right := r;
- result.Bottom := b;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsRect(const aTopLeft, aBottomRight: TtsPosition): TtsRect;
- begin
- result.TopLeft := aTopLeft;
- result.BottomRight := aBottomRight;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsVector4f(X, Y, Z, W: Single): TtsVector4f;
- begin
- result[0] := X;
- result[1] := Y;
- result[2] := Z;
- result[3] := W;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsMatrix4f(X, Y, Z, P: TtsVector4f): TtsMatrix4f;
- begin
- result[0] := X;
- result[1] := Y;
- result[2] := Z;
- result[3] := P;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsFormatSize(const aFormat: TtsFormat): Integer;
- begin
- case aFormat of
- tsFormatRGBA8: result := 4;
- tsFormatLumAlpha8: result := 2;
- tsFormatAlpha8: result := 1;
- tsFormatLum8: result := 1;
- else
- result := 0;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure tsFormatMap(const aFormat: TtsFormat; var aData: PByte; const aColor: TtsColor4f);
- var
- i: Integer;
- s: Single;
- begin
- case aFormat of
- tsFormatRGBA8: begin
- for i := 0 to 3 do begin
- aData^ := Trunc($FF * min(aColor.arr[i], 1.0));
- inc(aData);
- end;
- end;
-
- tsFormatLumAlpha8: begin
- s := 0.30 * min(aColor.r, 1.0) +
- 0.59 * min(aColor.g, 1.0) +
- 0.11 * min(aColor.b, 1.0);
- aData^ := Trunc($FF * s);
- inc(aData);
- aData^ := Trunc($FF * min(aColor.a, 1.0));
- inc(aData);
- end;
-
- tsFormatAlpha8: begin
- aData^ := Trunc($FF * min(aColor.a, 1.0));
- inc(aData);
- end;
-
- tsFormatLum8: begin
- s := 0.30 * min(aColor.r, 1.0) +
- 0.59 * min(aColor.g, 1.0) +
- 0.11 * min(aColor.b, 1.0);
- aData^ := Trunc($FF * s);
- inc(aData);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure tsFormatUnmap(const aFormat: TtsFormat; var aData: PByte; out aColor: TtsColor4f);
- var
- i: Integer;
- begin
- case aFormat of
- tsFormatRGBA8: begin
- for i := 0 to 3 do begin
- aColor.arr[i] := aData^ / $FF;
- inc(aData);
- end;
- end;
-
- tsFormatLumAlpha8: begin
- aColor.r := aData^ / $FF;
- aColor.g := aData^ / $FF;
- aColor.b := aData^ / $FF;
- inc(aData);
- aColor.a := aData^ / $FF;
- inc(aData);
- end;
-
- tsFormatAlpha8: begin
- aColor.r := 1.0;
- aColor.g := 1.0;
- aColor.b := 1.0;
- aColor.a := aData^ / $FF;
- inc(aData);
- end;
-
- tsFormatLum8: begin
- aColor.r := aData^ / $FF;
- aColor.g := aData^ / $FF;
- aColor.b := aData^ / $FF;
- aColor.a := 1.0;
- inc(aData);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsBlendValueIgnore(const aSrc, aDst: Single): Single;
- begin
- result := aDst;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsBlendValueReplace(const aSrc, aDst: Single): Single;
- begin
- result := aSrc;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsBlendValueModulate(const aSrc, aDst: Single): Single;
- begin
- result := aSrc * aDst;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsBlendColorAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
- var
- i: Integer;
- begin
- for i := 0 to 2 do
- result.arr[i] := aSrc.arr[i] * aSrc.a + aDst.arr[i] * (1 - aSrc.a);
- result.a := aSrc.a + aDst.a * (1 - aSrc.a);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsBlendColorAdditive(const aSrc, aDst: TtsColor4f): TtsColor4f;
- var
- i: Integer;
- begin
- for i := 0 to 3 do
- result.arr[i] := aSrc.arr[i] + aDst.arr[i];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsBlendColorAdditiveAlpha(const aSrc, aDst: TtsColor4f): TtsColor4f;
- var
- i: Integer;
- begin
- for i := 0 to 2 do
- result.arr[i] := aSrc.arr[i] * aSrc.a + aDst.arr[i];
- result.a := aDst.a;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsStrAlloc(aSize: Cardinal): PWideChar;
- begin
- aSize := (aSize + 1) shl 1;
- GetMem(result, aSize);
- FillChar(result^, aSize, 0);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsStrNew(const aText: PWideChar): PWideChar;
- begin
- result := tsStrAlloc(tsStrLength(aText));
- tsStrCopy(result, aText);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure tsStrDispose(const aText: PWideChar);
- begin
- FreeMem(aText);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsStrLength(aText: PWideChar): Cardinal;
- begin
- result := 0;
- if Assigned(aText) then
- while (ord(aText^) <> 0) do begin
- inc(result);
- inc(aText);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsStrCopy(aDst, aSrc: PWideChar): PWideChar;
- begin
- result := aDst;
- if Assigned(aDst) and Assigned(aSrc) then
- while ord(aSrc^) <> 0 do begin
- aDst^ := aSrc^;
- inc(aDst);
- inc(aSrc);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsAnsiToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar;
- const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
- begin
- case aCodePage of
- tsUTF8:
- result := tsUTF8ToWide(aDst, aSize, aSrc, aDefaultChar);
-
- tsISO_8859_1:
- result := tsISO_8859_1ToWide(aDst, aSize, aSrc);
- else
- result := tsAnsiSBCDToWide(aDst, aSize, aSrc, aCodePage, aDefaultChar);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsISO_8859_1ToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar): Integer;
- begin
- result := 0;
- if Assigned(aDst) and Assigned(aSrc) then
- while (ord(aSrc^) <> 0) and (result < aSize) do begin
- aDst^ := WideChar(aSrc^);
- inc(aDst);
- inc(aSrc);
- inc(result);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsUTF8ToWide(aDst: PWideChar; const aSize: Integer; const aSrc: PAnsiChar; const aDefaultChar: WideChar): Integer;
-
- procedure AddToDest(aCharCode: UInt64);
- begin
- if (aCharCode > $FFFF) then
- aCharCode := ord(aDefaultChar);
-
- PWord(aDst)^ := aCharCode;
- inc(aDst);
- result := result + 1;
- end;
-
- const
- STATE_STARTBYTE = 0;
- STATE_FOLLOWBYTE = 1;
- var
- cc: UInt64;
- len, state, c: Integer;
- p: PByte;
- tmp: Byte;
- begin
- result := 0;
- if not Assigned(aDst) or not Assigned(aSrc) or (aSize <= 0) then
- exit;
-
- c := 0;
- cc := 0;
- p := PByte(aSrc);
- len := Length(aSrc);
- state := STATE_STARTBYTE;
- while (len > 0) do begin
- case state of
- STATE_STARTBYTE: begin
- if (p^ and $80 = 0) then begin
- AddToDest(p^);
- end else if (p^ and $40 > 0) then begin
- tmp := p^;
- c := 0;
- while (tmp and $80) > 0 do begin
- inc(c);
- tmp := tmp shl 1;
- end;
- cc := p^ and ((1 shl (7 - c)) - 1);
- state := STATE_FOLLOWBYTE;
- c := c - 1;
- end;
- end;
-
- STATE_FOLLOWBYTE: begin
- if ((p^ and $C0) = $80) then begin
- cc := (cc shl 6) or (p^ and $3F);
- c := c - 1;
- if (c = 0) then begin
- AddToDest(cc);
- state := STATE_STARTBYTE;
- end;
- end else
- state := STATE_STARTBYTE;
- end;
- end;
-
- if (result >= aSize) then
- exit;
- inc(p);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsUTFBE16ToWide(aDst: PWideChar; const aDstSize: Integer; aSrc: PByte; aSrcSize: Integer;
- const aDefaultChar: WideChar): Integer;
- var
- tmp: Word;
-
- procedure AddToDest(aCharCode: Word);
- begin
- if ((aCharCode and $D800) = $D800) or
- ((aCharCode and $DC00) = $DC00) then
- aCharCode := Ord(aDefaultChar);
-
- aDst^ := WideChar(aCharCode);
- inc(aDst, 1);
- result := result + 1;
- end;
-
- begin
- result := 0;
- while (aSrcSize > 1) and (aDstSize > 0) do begin
- {$IFDEF FPC}
- tmp := (aSrc^ shl 8) or (aSrc + 1)^;
- {$ELSE}
- tmp := (PByteArray(aSrc)[0] shl 8) or PByteArray(aSrc)[1];
- {$ENDIF}
- inc(aSrc, 2);
- dec(aSrcSize, 2);
- AddToDest(tmp);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function tsAnsiSBCDToWide(aDst: PWideChar; const aSize: Integer; aSrc: PAnsiChar;
- const aCodePage: TtsCodePage; const aDefaultChar: WideChar): Integer;
- var
- tmp: WideChar;
- cp: PtsCodePageValues;
- begin
- result := 0;
- cp := TS_CODE_PAGE_LUT[aCodePage];
- if not Assigned(aDst) or
- not Assigned(aSrc) or
- not Assigned(cp) or
- (aSize < 0) then exit;
-
- while (Ord(aSrc^) <> 0) and (result < aSize) do begin
- tmp := WideChar(cp^[aSrc^]);
- if (ord(tmp) = 0) then begin
- if (ord(aDefaultChar) <> 0) then begin
- aDst^ := aDefaultChar;
- inc(aDst);
- end;
- end else begin
- aDst^ := tmp;
- inc(aDst);
- end;
- inc(aSrc);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TtsKernel1D///////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TtsKernel1D.Create(const aRadius, aStrength: Single);
- var
- TempRadius, SQRRadius, TempStrength, TempValue: Double;
- Idx: Integer;
-
- function CalcValue(const aIndex: Integer): Single;
- var
- Temp: Double;
- begin
- Temp := Max(0, Abs(aIndex) - TempStrength);
- Temp := Sqr(Temp * TempRadius) / SQRRadius;
- result := Exp(-Temp);
- end;
-
- begin
- inherited Create;
-
- // calculate new radius and strength
- TempStrength := Min(aRadius - 1, aRadius * aStrength);
- TempRadius := aRadius - TempStrength;
- SQRRadius := sqr(TempRadius) * sqr(TempRadius);
-
- // caluculating size of the kernel
- Size := Round(TempRadius);
- while CalcValue(Size) > 0.001 do
- Inc(Size);
- Size := Size -1;
- ItemCount := Size * 2 +1;
- SetLength(Items, ItemCount);
-
- // calculate Value (yes thats right. there is no -1)
- for Idx := 0 to Size do begin
- TempValue := CalcValue(Idx);
-
- with Items[Size + Idx] do begin
- Offset := Idx;
- Value := TempValue;
- end;
-
- with Items[Size - Idx] do begin
- Offset := -Idx;
- Value := TempValue;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TtsKernel2D///////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TtsKernel2D.Create(const aRadius, aStrength: Single);
- var
- tmpStrenght: Double;
- tmpRadius: Double;
- tmpValue: Double;
- sqrRadius: Double;
- x, y, w, h: Integer;
-
- function CalcValue(const aIndex: Double): Double;
- begin
- result := max(0, Abs(aIndex) - tmpStrenght);
- result := Sqr(result * tmpRadius) / sqrRadius;
- result := Exp(-result);
- end;
-
- procedure CalcSize(var aSize, aMidSize: Integer);
- begin
- aSize := 0;
- aMidSize := 0;
- while CalcValue(aSize) > 0.5 do begin
- inc(aSize, 1);
- inc(aMidSize, 1);
- end;
- while CalcValue(aSize) > 0.001 do
- Inc(aSize, 1);
- end;
-
- procedure SetItem(const x, y: Integer);
- begin
- with Items[(SizeY + y) * w + (SizeX + x)] do begin
- OffsetX := x;
- OffsetY := y;
- Value := tmpValue;
- end;
- end;
-
- procedure QuickSort(l, r: Integer);
- var
- _l, _r: Integer;
- p, t: TtsKernel2DItem;
- begin
- repeat
- _l := l;
- _r := r;
- p := Items[(l + r) shr 1];
-
- repeat
- while (Items[_l].Value > p.Value) do
- inc(_l, 1);
-
- while (Items[_r].Value < p.Value) do
- dec(_r, 1);
-
- if (_l <= _r) then begin
- t := Items[_l];
- Items[_l] := Items[_r];
- Items[_r] := t;
- inc(_l, 1);
- dec(_r, 1);
- end;
- until (_l > _r);
-
- if (l < _r) then
- QuickSort(l, _r);
-
- l := _l;
- until (_l >= r);
- end;
-
- begin
- inherited Create;
-
- tmpStrenght := Min(aRadius - 1.0, aRadius * aStrength);
- tmpRadius := aRadius - tmpStrenght;
- sqrRadius := sqr(tmpRadius) * sqr(tmpRadius);
-
- CalcSize(SizeX, MidSizeX);
- CalcSize(SizeY, MidSizeY);
-
- ValueSum := 0.0;
- w := 2 * SizeX + 1;
- h := 2 * SizeY + 1;
- ItemCount := w * h;
- SetLength(Items, ItemCount);
-
- for y := 0 to SizeY do begin
- for x := 0 to SizeX do begin
- tmpValue := CalcValue(sqrt(Sqr(x) + Sqr(y)));
-
- SetItem( x, y);
- SetItem( x, -y);
- SetItem(-x, -y);
- SetItem(-x, y);
-
- ValueSum := ValueSum + tmpValue;
- if (x > 0) and (y > 0) then
- ValueSum := ValueSum + tmpValue;
- end;
- end;
-
- QuickSort(0, ItemCount-1);
-
- while (Items[ItemCount-1].Value < 0.001) do
- dec(ItemCount, 1);
- SetLength(Items, ItemCount);
- end;
-
- end.
|