v3.i
git-svn-id: https://svn.code.sf.net/p/kolmck/code@78 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
parent
bbd0e2aee6
commit
19cb111bcd
@ -12,9 +12,8 @@
|
||||
|
||||
Key Objects Library (C) 2000 by Kladov Vladimir.
|
||||
|
||||
mailto: bonanzas@xcl.cjb.net
|
||||
Home: http://bonanzas.rinet.ru
|
||||
http://xcl.cjb.net
|
||||
mailto: vk@kolmck.net
|
||||
Home: http://kolmck.net
|
||||
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
|
||||
{
|
||||
@ -49,7 +48,7 @@ unit kolmath;
|
||||
|
||||
interface
|
||||
|
||||
uses err, kol;
|
||||
uses {$IFNDEF MATH_NOERR} err, {$ENDIF} kol;
|
||||
|
||||
const { Ranges of the IEEE floating point types, including denormals }
|
||||
MinSingle = 1.5e-45;
|
||||
@ -408,10 +407,12 @@ type
|
||||
const
|
||||
MaxIterations = 15;
|
||||
|
||||
{$IFNDEF MATH_NOERR}
|
||||
procedure ArgError(const Msg: string);
|
||||
begin
|
||||
raise Exception.Create(e_Math_InvalidArgument, Msg);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function DegToRad(Degrees: Extended): Extended; { Radians := Degrees * PI / 180 }
|
||||
begin
|
||||
@ -940,6 +941,15 @@ begin
|
||||
Result := Data[I];
|
||||
end;
|
||||
|
||||
{$IFDEF ASM_VERSION}
|
||||
function Min(A,B: Integer): Integer;
|
||||
asm
|
||||
CMP EAX, EDX
|
||||
JL @@1
|
||||
XCHG EAX, EDX
|
||||
@@1:
|
||||
end;
|
||||
{$ELSE}
|
||||
function Min(A,B: Integer): Integer;
|
||||
begin
|
||||
if A < B then
|
||||
@ -947,6 +957,7 @@ begin
|
||||
else
|
||||
Result := B;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF _D4orHigher}
|
||||
function Min(A,B: I64): I64;
|
||||
@ -1010,6 +1021,15 @@ begin
|
||||
Result := Data[I];
|
||||
end;
|
||||
|
||||
{$IFDEF ASM_VERSION}
|
||||
function Max(A,B: Integer): Integer;
|
||||
asm
|
||||
CMP EAX, EDX
|
||||
JG @@1
|
||||
XCHG EAX, EDX
|
||||
@@1:
|
||||
end;
|
||||
{$ELSE}
|
||||
function Max(A,B: Integer): Integer;
|
||||
begin
|
||||
if A > B then
|
||||
@ -1017,6 +1037,7 @@ begin
|
||||
else
|
||||
Result := B;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF _D4orHigher}
|
||||
function Max(A,B: I64): I64;
|
||||
@ -1161,24 +1182,31 @@ asm // IN: EAX = ptr to Data, EDX = High(Data) = Count - 1
|
||||
DD @@4
|
||||
@@4:
|
||||
ADD EAX, [ECX+12+EDX]
|
||||
JO RaiseOverflowError
|
||||
JO @@RaiseOverflowError
|
||||
@@3:
|
||||
ADD EAX, [ECX+8+EDX]
|
||||
JO RaiseOverflowError
|
||||
JO @@RaiseOverflowError
|
||||
@@2:
|
||||
ADD EAX, [ECX+4+EDX]
|
||||
JO RaiseOverflowError
|
||||
JO @@RaiseOverflowError
|
||||
@@1:
|
||||
ADD EAX, [ECX+EDX]
|
||||
JO RaiseOverflowError
|
||||
JO @@RaiseOverflowError
|
||||
SUB EDX,16
|
||||
JNS @@4
|
||||
POP EBX
|
||||
RET
|
||||
@@RaiseOverflowError:
|
||||
POP EBX
|
||||
POP ECX
|
||||
JMP RaiseOverflowError
|
||||
end;
|
||||
|
||||
procedure RaiseOverflowError;
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
raise Exception.Create(e_IntOverflow, SIntOverflow);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function SUM(const Data: array of Double): Extended;
|
||||
@ -1353,7 +1381,9 @@ end;
|
||||
function SLNDepreciation(Cost, Salvage: Extended; Life: Integer): Extended;
|
||||
{ Spreads depreciation linearly over life. }
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Life < 1 then ArgError('SLNDepreciation');
|
||||
{$ENDIF}
|
||||
Result := (Cost - Salvage) / Life
|
||||
end;
|
||||
|
||||
@ -1425,17 +1455,23 @@ var
|
||||
begin
|
||||
InternalRateOfReturn := 0;
|
||||
K := ConditionP(CashFlows);
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if K < 0 then ArgError('InternalRateOfReturn');
|
||||
{$ENDIF}
|
||||
if K = 0 then
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Guess <= -1.0 then ArgError('InternalRateOfReturn');
|
||||
{$ENDIF}
|
||||
T := -LnXP1(Guess)
|
||||
end else
|
||||
T := 0.0;
|
||||
for Count := 1 to MaxIterations do
|
||||
begin
|
||||
PolyX(CashFlows, Exp(T), Poly);
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Poly.Pos <= Poly.Neg then ArgError('InternalRateOfReturn');
|
||||
{$ENDIF}
|
||||
if (Poly.Neg >= 0.0) or (Poly.Pos <= 0.0) then
|
||||
begin
|
||||
InternalRateOfReturn := -1.0;
|
||||
@ -1450,7 +1486,9 @@ begin
|
||||
Exit;
|
||||
end
|
||||
end;
|
||||
{$IFNDEF MATH_NOERR}
|
||||
ArgError('InternalRateOfReturn');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function NetPresentValue(Rate: Extended; const CashFlows: array of Double;
|
||||
@ -1461,7 +1499,9 @@ var
|
||||
rr: Extended;
|
||||
I: Integer;
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Rate <= -1.0 then ArgError('NetPresentValue');
|
||||
{$ENDIF}
|
||||
rr := 1/(1+Rate);
|
||||
result := 0;
|
||||
for I := High(CashFlows) downto Low(CashFlows) do
|
||||
@ -1510,7 +1550,9 @@ var
|
||||
Arn:extended; { =AnnuityF(Rate,NPeriods) }
|
||||
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Rate <= -1.0 then ArgError('PaymentParts');
|
||||
{$ENDIF}
|
||||
Crp:=Compound(Rate,Period-1);
|
||||
Arn:=Annuity2(Rate,NPeriods,PaymentTime,Crn);
|
||||
IntPmt:=(FutureValue*(Crp-1)-PresentValue*(Crn-Crp))/Arn;
|
||||
@ -1522,9 +1564,13 @@ function FutureValue(Rate: Extended; NPeriods: Integer; Payment, PresentValue:
|
||||
var
|
||||
Annuity, CompoundRN: Extended;
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Rate <= -1.0 then ArgError('FutureValue');
|
||||
{$ENDIF}
|
||||
Annuity := Annuity2(Rate, NPeriods, PaymentTime, CompoundRN);
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if CompoundRN > 1.0E16 then ArgError('FutureValue');
|
||||
{$ENDIF}
|
||||
FutureValue := -Payment * Annuity - PresentValue * CompoundRN
|
||||
end;
|
||||
|
||||
@ -1535,11 +1581,13 @@ var
|
||||
Crn:extended; { compound(rate,nperiods)}
|
||||
Arn:extended; { annuityf(rate,nperiods)}
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if (Rate <= -1.0)
|
||||
or (Period < 1) or (Period > NPeriods) then ArgError('InterestPayment');
|
||||
Crp:=Compound(Rate,Period-1);
|
||||
Arn:=Annuity2(Rate,Nperiods,PaymentTime,Crn);
|
||||
InterestPayment:=(FutureValue*(Crp-1)-PresentValue*(Crn-Crp))/Arn;
|
||||
{$ENDIF}
|
||||
Crp:=Compound(Rate,Period-1);
|
||||
Arn:=Annuity2(Rate,Nperiods,PaymentTime,Crn);
|
||||
InterestPayment:=(FutureValue*(Crp-1)-PresentValue*(Crn-Crp))/Arn;
|
||||
end;
|
||||
|
||||
function InterestRate(NPeriods: Integer;
|
||||
@ -1577,7 +1625,9 @@ var
|
||||
|
||||
begin
|
||||
Result := 0;
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if NPeriods <= 0 then ArgError('InterestRate');
|
||||
{$ENDIF}
|
||||
Pmt := Payment;
|
||||
if PaymentTime = ptEndOfPeriod then
|
||||
begin
|
||||
@ -1605,7 +1655,9 @@ begin
|
||||
Pmt := -Pmt;
|
||||
Last := -Last
|
||||
end;
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if (First = 0.0) or (Last < 0.0) then ArgError('InterestRate');
|
||||
{$ENDIF}
|
||||
T := 0.0; { Guess at solution }
|
||||
for Count := 1 to MaxIterations do
|
||||
begin
|
||||
@ -1639,7 +1691,9 @@ begin
|
||||
Exit;
|
||||
end
|
||||
end;
|
||||
{$IFNDEF MATH_NOERR}
|
||||
ArgError('InterestRate');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
function NumberOfPeriods(Rate, Payment, PresentValue, FutureValue: Extended;
|
||||
@ -1654,8 +1708,9 @@ var
|
||||
T: Extended;
|
||||
|
||||
begin
|
||||
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Rate <= -1.0 then ArgError('NumberOfPeriods');
|
||||
{$ENDIF}
|
||||
|
||||
{whenever both Payment and PaymentTime are given together, the PaymentTime has the effect
|
||||
of modifying the effective Payment by the interest accrued on the Payment}
|
||||
@ -1672,7 +1727,9 @@ begin
|
||||
be numerically unstable, but not as likely to cause an error.}
|
||||
|
||||
PVRPP:=PresentValue*Rate+Payment;
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if PVRPP=0 then ArgError('NumberOfPeriods');
|
||||
{$ENDIF}
|
||||
|
||||
{ 6.1E-5 approx= 2**-14 }
|
||||
if ( EAbs(Rate)<6.1E-5 ) then
|
||||
@ -1686,7 +1743,9 @@ begin
|
||||
reasonableness of the cashflow before computing the NPER.}
|
||||
|
||||
T:= -(PresentValue+FutureValue)*Rate/PVRPP;
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if T<=-1.0 then ArgError('NumberOfPeriods');
|
||||
{$ENDIF}
|
||||
Result := LnXP1(T) / LnXP1(Rate)
|
||||
end;
|
||||
NumberOfPeriods:=Result;
|
||||
@ -1697,7 +1756,9 @@ function Payment(Rate: Extended; NPeriods: Integer; PresentValue, FutureValue:
|
||||
var
|
||||
Annuity, CompoundRN: Extended;
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Rate <= -1.0 then ArgError('Payment');
|
||||
{$ENDIF}
|
||||
Annuity := Annuity2(Rate, NPeriods, PaymentTime, CompoundRN);
|
||||
if CompoundRN > 1.0E16 then
|
||||
Payment := -PresentValue * Rate / (1 + Integer(PaymentTime) * Rate)
|
||||
@ -1710,7 +1771,9 @@ function PeriodPayment(Rate: Extended; Period, NPeriods: Integer;
|
||||
var
|
||||
Junk: Extended;
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if (Rate <= -1.0) or (Period < 1) or (Period > NPeriods) then ArgError('PeriodPayment');
|
||||
{$ENDIF}
|
||||
PeriodPayment := PaymentParts(Period, NPeriods, Rate, PresentValue,
|
||||
FutureValue, PaymentTime, Junk);
|
||||
end;
|
||||
@ -1720,7 +1783,9 @@ function PresentValue(Rate: Extended; NPeriods: Integer; Payment, FutureValue:
|
||||
var
|
||||
Annuity, CompoundRN: Extended;
|
||||
begin
|
||||
{$IFNDEF MATH_NOERR}
|
||||
if Rate <= -1.0 then ArgError('PresentValue');
|
||||
{$ENDIF}
|
||||
Annuity := Annuity2(Rate, NPeriods, PaymentTime, CompoundRN);
|
||||
if CompoundRN > 1.0E16 then
|
||||
PresentValue := -(Payment / Rate * Integer(PaymentTime) * Payment)
|
||||
|
||||
@ -21,11 +21,10 @@
|
||||
|
||||
Key Objects Library (C) 2000 by Kladov Vladimir.
|
||||
|
||||
mailto: bonanzas@xcl.cjb.net
|
||||
Home: http://kol.nm.ru
|
||||
http://xcl.cjb.net
|
||||
http://xcl.nm.ru
|
||||
mailto: vk@kolmck.net
|
||||
Home: http://kolmck.net
|
||||
|
||||
This version is compatible with KOL 3.00+
|
||||
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
|
||||
{
|
||||
This code is grabbed mainly from standard SysUtils.pas unit,
|
||||
@ -125,7 +124,7 @@ resourcestring
|
||||
SReadAccess = 'Read';
|
||||
SWriteAccess = 'Write';
|
||||
//SResultTooLong = 'Format result longer than 4096 characters';
|
||||
//SFormatTooLong = 'Format AnsiString too long';
|
||||
//SFormatTooLong = 'Format string too long';
|
||||
SExternalException = 'External exception %x';
|
||||
SAssertionFailed = 'Assertion failed';
|
||||
SIntfCastError = 'Interface not supported';
|
||||
@ -152,7 +151,7 @@ type
|
||||
|
||||
{ Generic filename type }
|
||||
|
||||
TFileName = type AnsiString;
|
||||
TFileName = type string;
|
||||
|
||||
{ Exceptions }
|
||||
Exception = class;
|
||||
@ -177,31 +176,31 @@ type
|
||||
protected
|
||||
FCode: TError;
|
||||
FErrorCode: DWORD;
|
||||
FMessage: AnsiString;
|
||||
FMessage: KOLString;
|
||||
FExceptionRecord: PExceptionRecord;
|
||||
FData: Pointer;
|
||||
FOnDestroy: TDestroyException;
|
||||
procedure SetData(const Value: Pointer);
|
||||
public
|
||||
constructor Create(ACode: TError; const Msg: AnsiString);
|
||||
constructor Create(ACode: TError; const Msg: string);
|
||||
{* Use this constructor to raise exception, which does not require of
|
||||
argument formatting. }
|
||||
constructor CreateFmt(ACode: TError; const Msg: AnsiString; const Args: array of const);
|
||||
{* Use this constructor to raise an exception with formatted Message AnsiString.
|
||||
constructor CreateFmt(ACode: TError; const Msg: string; const Args: array of const);
|
||||
{* Use this constructor to raise an exception with formatted Message string.
|
||||
Take into attention, that Format procedure defined in KOL, uses API wvsprintf
|
||||
function, which can understand a restricted set of format specifications. }
|
||||
constructor CreateCustom(AError: DWORD; const Msg: AnsiString);
|
||||
constructor CreateCustom(AError: DWORD; const Msg: String);
|
||||
{* Use this constructor to create e_Custom exception and to assign AError to
|
||||
its ErrorCode property. }
|
||||
constructor CreateCustomFmt(AError: DWORD; const Msg: AnsiString; const Args: array of const);
|
||||
constructor CreateCustomFmt(AError: DWORD; const Msg: String; const Args: array of const);
|
||||
{* Use this constructor to create e_Custom exception with formatted message
|
||||
AnsiString and to assign AError to its ErrorCode property. }
|
||||
string and to assign AError to its ErrorCode property. }
|
||||
constructor CreateResFmt(ACode: TError; Ident: Integer; const Args: array of const);
|
||||
{* }
|
||||
destructor Destroy; override;
|
||||
{* destructor }
|
||||
property Message: AnsiString read FMessage; // write FMessage;
|
||||
{* Text AnsiString, containing descriptive message about the exception. }
|
||||
property Message: KOLString read FMessage; // write FMessage;
|
||||
{* Text string, containing descriptive message about the exception. }
|
||||
property Code: TError read FCode;
|
||||
{* Main exception code. This property can be used to determine, which exception
|
||||
occure. }
|
||||
@ -253,7 +252,7 @@ procedure AddExitProc(Proc: TProcedure);
|
||||
|
||||
{ System error messages }
|
||||
|
||||
function SysErrorMessage(ErrorCode: Integer): AnsiString;
|
||||
function SysErrorMessage(ErrorCode: Integer): string;
|
||||
|
||||
{ Exception handling routines }
|
||||
|
||||
@ -327,7 +326,7 @@ function SafeLoadLibrary(const Filename: KOLString;
|
||||
|
||||
implementation
|
||||
|
||||
{procedure ConvertError(const Ident: AnsiString);
|
||||
{procedure ConvertError(const Ident: string);
|
||||
begin
|
||||
raise Exception.Create(e_Convert, Ident);
|
||||
end;
|
||||
@ -385,7 +384,7 @@ end;
|
||||
|
||||
{ System error messages }
|
||||
|
||||
function SysErrorMessage(ErrorCode: Integer): AnsiString;
|
||||
function SysErrorMessage(ErrorCode: Integer): string;
|
||||
var
|
||||
Len: Integer;
|
||||
Buffer: array[0..255] of KOLChar;
|
||||
@ -492,7 +491,7 @@ end;
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF _D2}
|
||||
function LoadStr(Ident: Integer): AnsiString;
|
||||
function LoadStr(Ident: Integer): string;
|
||||
var
|
||||
Buffer: array[0..1023] of Char;
|
||||
begin
|
||||
@ -500,7 +499,7 @@ begin
|
||||
SizeOf(Buffer)));
|
||||
end;
|
||||
{$ELSE}
|
||||
function LoadStr(Ident: Integer): AnsiString;
|
||||
function LoadStr(Ident: Integer): string;
|
||||
var
|
||||
Buffer: array[0..1023] of KOLChar;
|
||||
begin
|
||||
@ -508,7 +507,7 @@ begin
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
function FmtLoadStr(Ident: Integer; const Args: array of const): AnsiString;
|
||||
function FmtLoadStr(Ident: Integer; const Args: array of const): string;
|
||||
begin
|
||||
//FmtStr(Result, LoadStr(Ident), Args);
|
||||
Result := Format(LoadStr(Ident), Args);
|
||||
@ -517,12 +516,12 @@ end;
|
||||
function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
|
||||
Buffer: PKOLChar; Size: Integer): Integer;
|
||||
var
|
||||
MsgPtr: PAnsiChar;
|
||||
//MsgEnd: PAnsiChar;
|
||||
MsgPtr: PKOLChar;
|
||||
//MsgEnd: PChar;
|
||||
//MsgLen: Integer;
|
||||
ModuleName: array[0..MAX_PATH] of KOLChar;
|
||||
//Temp: array[0..MAX_PATH] of Char;
|
||||
Fmt: array[0..255] of AnsiChar;
|
||||
Fmt: array[0..255] of KOLChar;
|
||||
Info: TMemoryBasicInformation;
|
||||
ConvertedAddress: Pointer;
|
||||
begin
|
||||
@ -543,21 +542,21 @@ begin
|
||||
//MsgEnd := '';
|
||||
if ExceptObject is Exception then
|
||||
begin
|
||||
MsgPtr := PAnsiChar(Exception(ExceptObject).Message);
|
||||
MsgPtr := PKOLChar(Exception(ExceptObject).Message);
|
||||
//MsgLen := StrLen(MsgPtr);
|
||||
//if (MsgLen <> 0) and (MsgPtr[MsgLen - 1] <> '.') then MsgEnd := '.';
|
||||
{-} // Isn't it too beautiful - devote ~40 bytes of code just to decide,
|
||||
// add or not a point at the end of the message.
|
||||
end;
|
||||
{$IFNDEF USE_RESOURCESTRING}
|
||||
StrCopy( Fmt, SException );
|
||||
{$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF}( Fmt, SException );
|
||||
{$ELSE}
|
||||
LoadString(FindResourceHInstance(HInstance),
|
||||
PResStringRec(@SException).Identifier, Fmt, SizeOf(Fmt));
|
||||
{$ENDIF}
|
||||
//MsgOK( ModuleName );
|
||||
{$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF}
|
||||
( Buffer, PKOLChar( Format( KOLString(Fmt), [ ExceptObject.ClassName,
|
||||
( Buffer, PKOLChar( Format( Fmt, [ ExceptObject.ClassName,
|
||||
ModuleName, ConvertedAddress, MsgPtr, '' {MsgEnd}]) ) );
|
||||
Result := {$IFDEF UNICODE_CTRLS} WStrLen {$ELSE} StrLen {$ENDIF}(Buffer);
|
||||
end;
|
||||
@ -620,21 +619,21 @@ begin
|
||||
FData := Value;
|
||||
end;
|
||||
|
||||
constructor Exception.Create(ACode: TError; const Msg: AnsiString);
|
||||
constructor Exception.Create(ACode: TError; const Msg: string);
|
||||
begin
|
||||
FCode := ACode;
|
||||
FMessage := Msg;
|
||||
//FAllowFree := TRUE;
|
||||
end;
|
||||
|
||||
constructor Exception.CreateCustom(AError: DWORD; const Msg: AnsiString);
|
||||
constructor Exception.CreateCustom(AError: DWORD; const Msg: String);
|
||||
begin
|
||||
FCode := e_Custom;
|
||||
FMessage := Msg;
|
||||
FErrorCode := AError;
|
||||
end;
|
||||
|
||||
constructor Exception.CreateCustomFmt(AError: DWORD; const Msg: AnsiString;
|
||||
constructor Exception.CreateCustomFmt(AError: DWORD; const Msg: String;
|
||||
const Args: array of const);
|
||||
begin
|
||||
FCode := e_Custom;
|
||||
@ -642,7 +641,7 @@ begin
|
||||
FMessage := Format(Msg, Args);
|
||||
end;
|
||||
|
||||
constructor Exception.CreateFmt(ACode: TError; const Msg: AnsiString;
|
||||
constructor Exception.CreateFmt(ACode: TError; const Msg: string;
|
||||
const Args: array of const);
|
||||
begin
|
||||
FCode := ACode;
|
||||
@ -663,7 +662,7 @@ function CreateInOutError: Exception;
|
||||
type
|
||||
TErrorRec = record
|
||||
Code: Integer;
|
||||
Ident: AnsiString;
|
||||
Ident: string;
|
||||
end;
|
||||
const
|
||||
ErrorMap: array[0..5] of TErrorRec = (
|
||||
@ -694,7 +693,7 @@ end;
|
||||
type
|
||||
TExceptMapRec = packed record
|
||||
ECode: TError;
|
||||
EIdent: AnsiString;
|
||||
EIdent: String;
|
||||
end;
|
||||
|
||||
const
|
||||
@ -765,10 +764,10 @@ end;
|
||||
{ routine RaiseAssertException sets up the registers just as if the user }
|
||||
{ code itself had raised the exception. }
|
||||
|
||||
function CreateAssertException(const Message, Filename: AnsiString;
|
||||
function CreateAssertException(const Message, Filename: string;
|
||||
LineNumber: Integer): Exception;
|
||||
var
|
||||
S: AnsiString;
|
||||
S: string;
|
||||
begin
|
||||
if Message <> '' then S := Message else S := SAssertionFailed;
|
||||
Result := Exception.CreateFmt(e_Assertion, SAssertError,
|
||||
@ -790,13 +789,13 @@ end;
|
||||
{ If you change this procedure, make sure it does not have any local variables }
|
||||
{ or temps that need cleanup - they won't get cleaned up due to the way }
|
||||
{ RaiseAssertException frame works. Also, it can not have an exception frame. }
|
||||
procedure AssertErrorHandler(const Message, Filename: AnsiString;
|
||||
procedure AssertErrorHandler(const Message, Filename: string;
|
||||
LineNumber: Integer; ErrorAddr: Pointer);
|
||||
var
|
||||
E: Exception;
|
||||
begin
|
||||
E := CreateAssertException(Message, Filename, LineNumber);
|
||||
RaiseAssertException(E, ErrorAddr, PAnsiChar(@ErrorAddr)+4);
|
||||
RaiseAssertException(E, ErrorAddr, PChar(@ErrorAddr)+4);
|
||||
end;
|
||||
|
||||
{ Abstract method invoke error handler }
|
||||
@ -891,7 +890,7 @@ var
|
||||
|
||||
function CreateAVObject: Exception;
|
||||
var
|
||||
AccessOp: AnsiString; // AnsiString ID indicating the access type READ or WRITE
|
||||
AccessOp: string; // string ID indicating the access type READ or WRITE
|
||||
AccessAddress: Pointer;
|
||||
MemInfo: TMemoryBasicInformation;
|
||||
ModName: array[0..MAX_PATH] of KOLChar;
|
||||
@ -933,7 +932,7 @@ end;
|
||||
procedure ExceptHandler(ExceptObject: TObject; ExceptAddr: Pointer); far;
|
||||
begin
|
||||
ShowException(ExceptObject, ExceptAddr);
|
||||
Halt(1);
|
||||
Halt(1);
|
||||
end;
|
||||
|
||||
{+}
|
||||
|
||||
@ -218,9 +218,9 @@ That is all to have full compatibility.
|
||||
// directive there. (Search the word: USE_CUSTOMEXTENSIONS).
|
||||
// Please note, that this option is not fully supported now.
|
||||
|
||||
{$IFNDEF NOT_UNLOAD_RICHEDITLIB}
|
||||
{$DEFINE UNLOAD_RICHEDITLIB}
|
||||
{$ENDIF}
|
||||
//{$IFNDEF NOT_UNLOAD_RICHEDITLIB}
|
||||
// {$DEFINE UNLOAD_RICHEDITLIB}
|
||||
//{$ENDIF}
|
||||
// You can freely comment this directive. 1st, if the application does not
|
||||
// use richedit control. 2nd, even if it does, freeing the library handle
|
||||
// actually is not needed.
|
||||
@ -248,5 +248,4 @@ That is all to have full compatibility.
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
|
||||
{$DEFINE DIBPixels32bitWithAlpha}
|
||||
612
KOL_ASM.inc
612
KOL_ASM.inc
@ -2178,63 +2178,6 @@ asm
|
||||
POP EBX
|
||||
end;
|
||||
|
||||
function TCanvas.TextExtent(const Text: AnsiString): TSize;
|
||||
asm
|
||||
PUSH EBX
|
||||
PUSH ESI
|
||||
MOV EBX, EAX
|
||||
|
||||
PUSH ECX // prepare @Result
|
||||
|
||||
MOV EAX, EDX
|
||||
CALL System.@LStrLen
|
||||
PUSH EAX // prepare Length(Text)
|
||||
|
||||
CALL EDX2PChar
|
||||
PUSH EDX // prepare PChar(Text)
|
||||
|
||||
PUSH HandleValid or FontValid
|
||||
PUSH EBX
|
||||
CALL RequiredState
|
||||
|
||||
XCHG ESI, EAX
|
||||
TEST ESI, ESI // ESI = fHandle before
|
||||
JNZ @@1
|
||||
|
||||
PUSH ESI
|
||||
CALL CreateCompatibleDC
|
||||
|
||||
MOV EDX, EBX
|
||||
XCHG EAX, EDX // EAX := @Self; EDX := DC
|
||||
CALL SetHandle
|
||||
|
||||
//****************************************************** // Added By M.Gerasimov
|
||||
CMP [EBX].TCanvas.fIsPaintDC, 1
|
||||
JZ @@2
|
||||
XOR ESI,ESI
|
||||
@@2:
|
||||
//******************************************************
|
||||
|
||||
@@1:
|
||||
PUSH HandleValid or FontValid
|
||||
PUSH EBX
|
||||
CALL RequiredState
|
||||
PUSH EAX // prepare DC
|
||||
|
||||
CALL Windows.GetTextExtentPoint32A // KOL_ANSI
|
||||
|
||||
TEST ESI, ESI
|
||||
JNZ @@exit
|
||||
|
||||
XOR EDX, EDX
|
||||
XCHG EAX, EBX
|
||||
CALL SetHandle
|
||||
|
||||
@@exit:
|
||||
POP ESI
|
||||
POP EBX
|
||||
end;
|
||||
|
||||
procedure TCanvas.TextRect(const Rect: TRect; X, Y: Integer; const Text: Ansistring);
|
||||
asm
|
||||
PUSH EBX
|
||||
@ -2795,8 +2738,8 @@ asm //cmd //opd
|
||||
CALL System.@GetMem
|
||||
POP EDX
|
||||
PUSH EAX
|
||||
MOV CL, 0
|
||||
CALL System.@FillChar
|
||||
//MOV CL, 0
|
||||
CALL ZeroMemory
|
||||
POP EAX
|
||||
@@exit:
|
||||
end;
|
||||
@ -3346,189 +3289,6 @@ asm
|
||||
POP EAX
|
||||
end;
|
||||
|
||||
function _NewTControl( AParent: PControl ): PControl;
|
||||
begin
|
||||
New( Result, CreateParented( AParent ) );
|
||||
end;
|
||||
|
||||
function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar;
|
||||
Ctl3D: Boolean; ACommandActions: TCommandActionsParam ): PControl;
|
||||
asm
|
||||
PUSH EBX
|
||||
PUSH ESI
|
||||
PUSH EDI
|
||||
MOV EDI, [ACommandActions]
|
||||
MOV [ACommandActions], ECX // Ctl3D -> ACommandActions
|
||||
|
||||
PUSH EDX // ControlClassName
|
||||
|
||||
MOV ESI, EAX // ESI = AParent
|
||||
CALL _NewTControl
|
||||
XCHG EBX, EAX // EBX = Result
|
||||
POP [EBX].TControl.fControlClassName
|
||||
//INC [EBX].TControl.fWindowed // set in TControl.Init
|
||||
|
||||
{$IFDEF COMMANDACTIONS_OBJ}
|
||||
MOV EAX, EDI
|
||||
CMP EAX, 120
|
||||
JB @@IdxActions_Loaded
|
||||
MOVZX EAX, byte ptr[EDI]
|
||||
@@IdxActions_Loaded:
|
||||
PUSH EAX
|
||||
MOV ECX, dword ptr [AllActions_Objs + EAX*4]
|
||||
JECXZ @@create_new_action
|
||||
XCHG EAX, ECX
|
||||
PUSH EAX
|
||||
CALL TObj.RefInc
|
||||
POP EAX
|
||||
JMP @@action_assign
|
||||
|
||||
@@create_new_action:
|
||||
{$IFDEF PACK_COMMANDACTIONS}
|
||||
MOV EAX, EDI
|
||||
CALL NewCommandActionsObj_Packed
|
||||
{$ELSE not PACK_COMMANDACTIONS}
|
||||
CALL NewCommandActionsObj
|
||||
|
||||
TEST EDI, EDI
|
||||
JZ @@no_actions
|
||||
|
||||
PUSH EAX
|
||||
LEA EDX, [EAX].TCommandActionsObj.aClear
|
||||
XCHG EAX, EDI
|
||||
XOR ECX, ECX
|
||||
MOV CL, Byte(Sizeof(TCommandActions))
|
||||
CALL Move
|
||||
POP EAX
|
||||
JMP @@action_assign
|
||||
@@no_actions:
|
||||
{$ENDIF not PACK_COMMANDACTIONS}
|
||||
MOV [EAX].TCommandActionsObj.aClear, offset[ClearText]
|
||||
|
||||
@@action_assign:
|
||||
POP EDX
|
||||
MOV dword ptr [AllActions_Objs + EDX*4], EAX
|
||||
|
||||
MOV [EBX].TControl.fCommandActions, EAX
|
||||
XCHG EDX, EAX
|
||||
MOV EAX, EBX
|
||||
CALL TControl.Add2AutoFree
|
||||
|
||||
{$ELSE}
|
||||
TEST EDI, EDI
|
||||
JZ @@no_actions2
|
||||
LEA EDX, [EBX].TControl.fCommandActions
|
||||
XCHG EAX, EDI
|
||||
XOR ECX, ECX
|
||||
MOV CL, Byte(Sizeof(TCommandActions))
|
||||
CALL Move
|
||||
JMP @@actions_created
|
||||
@@no_actions2:
|
||||
MOV [EBX].TControl.fCommandActions.TCommandActions.aClear, offset[ClearText]
|
||||
{$ENDIF}
|
||||
@@actions_created:
|
||||
|
||||
TEST ESI, ESI
|
||||
JZ @@no_parent
|
||||
|
||||
(*
|
||||
PUSH ESI
|
||||
LEA ESI, [ESI].TControl.PP.fWndProcResizeFlicks
|
||||
LEA EDI, [EBX].TControl.PP.fWndProcResizeFlicks
|
||||
MOVSD // fWndProcResizeFlicks
|
||||
MOVSD // fGotoControl
|
||||
POP ESI
|
||||
*)
|
||||
LEA ESI, [ESI].TControl.fTextColor
|
||||
LEA EDI, [EBX].TControl.fTextColor
|
||||
MOVSD // fTextColor
|
||||
MOVSD // fColor
|
||||
|
||||
{$IFDEF SMALLEST_CODE}
|
||||
{$IFDEF SMALLEST_CODE_PARENTFONT}
|
||||
LODSD
|
||||
XCHG EDX, EAX
|
||||
XOR EAX, EAX
|
||||
CALL TGraphicTool.Assign
|
||||
STOSD // fFont
|
||||
{$ELSE}
|
||||
LODSD
|
||||
XOR EAX, EAX
|
||||
STOSD // fFont = nil
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
LODSD
|
||||
XCHG EDX, EAX
|
||||
XOR EAX, EAX
|
||||
PUSH EDX
|
||||
CALL TGraphicTool.Assign
|
||||
STOSD // fFont
|
||||
POP EDX
|
||||
XCHG ECX, EAX
|
||||
JECXZ @@no_font
|
||||
MOV [ECX].TGraphicTool.fParentGDITool, EDX
|
||||
MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.FontChanged]
|
||||
MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX
|
||||
MOV EAX, EBX
|
||||
MOV EDX, ECX
|
||||
CALL TControl.FontChanged
|
||||
{$IFDEF USE_AUTOFREE4CONTROLS}
|
||||
MOV EAX, EBX
|
||||
MOV EDX, [EBX].TControl.fFont
|
||||
CALL TControl.Add2AutoFree
|
||||
{$ENDIF}
|
||||
@@no_font:
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF SMALLEST_CODE}
|
||||
LODSD
|
||||
XOR EAX, EAX
|
||||
STOSD
|
||||
{$ELSE}
|
||||
LODSD
|
||||
XCHG EDX, EAX
|
||||
XOR EAX, EAX
|
||||
PUSH EDX
|
||||
CALL TGraphicTool.Assign
|
||||
STOSD // fBrush
|
||||
POP EDX
|
||||
XCHG ECX, EAX
|
||||
JECXZ @@no_brush
|
||||
MOV [ECX].TGraphicTool.fParentGDITool, EDX
|
||||
MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.BrushChanged]
|
||||
MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX
|
||||
MOV EAX, EBX
|
||||
MOV EDX, ECX
|
||||
CALL TControl.BrushChanged
|
||||
{$IFDEF USE_AUTOFREE4CONTROLS}
|
||||
MOV EAX, EBX
|
||||
MOV EDX, [EBX].TControl.fBrush
|
||||
CALL TControl.Add2AutoFree
|
||||
{$ENDIF}
|
||||
@@no_brush:
|
||||
{$ENDIF}
|
||||
|
||||
MOVSB // fMargin
|
||||
LODSD // skip fClientXXXXX
|
||||
ADD EDI, 4
|
||||
|
||||
LODSB // fCtl3D_child
|
||||
TEST AL, 2
|
||||
JZ @@passed3D
|
||||
MOV EDX, [ACommandActions] // DL <- Ctl3D !!!
|
||||
AND AL, not 1
|
||||
AND DL, 1
|
||||
OR EAX, EDX
|
||||
@@passed3D:
|
||||
STOSB // fCtl3D_child
|
||||
|
||||
@@no_parent:
|
||||
XCHG EAX, EBX
|
||||
POP EDI
|
||||
POP ESI
|
||||
POP EBX
|
||||
end;
|
||||
|
||||
function NewForm( AParent: PControl; const Caption: KOLString ): PControl;
|
||||
const FormClass: array[ 0..4 ] of KOLChar = ( 'F', 'o', 'r', 'm', #0 );
|
||||
asm
|
||||
@ -9915,6 +9675,30 @@ procedure TStrList.Sort(CaseSensitive: Boolean);
|
||||
asm
|
||||
MOV [EAX].fCaseSensitiveSort, DL
|
||||
MOV [EAX].fAnsiSort, 0
|
||||
{$IFDEF SPEED_FASTER}
|
||||
{$DEFINE SORT_STRLIST_ARRAY}
|
||||
{$ENDIF}
|
||||
{$IFDEF TLIST_FAST}
|
||||
{$UNDEF SORT_STRLIST_ARRAY}
|
||||
{$ENDIF}
|
||||
{$IFDEF SORT_STRLIST_ARRAY}
|
||||
MOV ECX, offset[StrComp]
|
||||
CMP DL, 0
|
||||
JNZ @@01
|
||||
{$IFDEF SMALLER_CODE}
|
||||
MOV ECX, offset[StrComp_NoCase]
|
||||
{$ELSE}
|
||||
MOV ECX, [StrComp_NoCase]
|
||||
{$ENDIF}
|
||||
@@01:
|
||||
MOV EAX, [EAX].fList
|
||||
MOV EDX, [EAX].TList.fCount
|
||||
CMP EDX, 1
|
||||
JLE @@02
|
||||
MOV EAX, [EAX].TList.fItems
|
||||
CALL SortArray
|
||||
@@02:
|
||||
{$ELSE}
|
||||
PUSH Offset[TStrList.Swap]
|
||||
MOV ECX, Offset[CompareStrListItems_Case]
|
||||
CMP DL, 0
|
||||
@ -9922,19 +9706,7 @@ asm
|
||||
MOV ECX, Offset[CompareStrListItems_NoCase]
|
||||
@1: MOV EDX, [EAX].fCount
|
||||
CALL SortData
|
||||
end;
|
||||
|
||||
procedure TStrList.AnsiSort(CaseSensitive: Boolean);
|
||||
asm
|
||||
MOV [EAX].fCaseSensitiveSort, DL
|
||||
MOV [EAX].fAnsiSort, 1
|
||||
PUSH Offset[TStrList.Swap]
|
||||
MOV ECX, Offset[CompareAnsiStrListItems]
|
||||
CMP DL, 0
|
||||
JZ @1
|
||||
MOV ECX, Offset[CompareAnsiStrListItems_Case]
|
||||
@1: MOV EDX, [EAX].fCount
|
||||
CALL SortData
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
procedure TStrList.MergeFromFile(const FileName: KOLString);
|
||||
@ -10166,6 +9938,326 @@ asm
|
||||
|
||||
end;
|
||||
|
||||
procedure SortArray( const Data: Pointer; const uNElem: Dword;
|
||||
const CompareFun: TCompareArrayEvent );
|
||||
asm
|
||||
PUSH EBP
|
||||
MOV EBP, ESP
|
||||
CMP EDX, 2
|
||||
JL @@exit
|
||||
|
||||
SUB EAX, 4
|
||||
PUSH EAX // [EBP-4] = Data
|
||||
PUSH ECX // [EBP-8] = CompareFun
|
||||
PUSH EBX // EBX = pivotP
|
||||
XOR EBX, EBX
|
||||
INC EBX // EBX = 1 to pass to qSortHelp as PivotP
|
||||
MOV EAX, EDX // EAX = nElem
|
||||
CALL @@qSortHelp
|
||||
POP EBX
|
||||
POP ECX
|
||||
POP ECX
|
||||
@@exit:
|
||||
POP EBP
|
||||
RET
|
||||
|
||||
@@qSortHelp:
|
||||
PUSH EBX // EBX (in) = PivotP
|
||||
PUSH ESI // ESI = leftP
|
||||
PUSH EDI // EDI = rightP
|
||||
|
||||
@@TailRecursion:
|
||||
CMP EAX, 2
|
||||
JG @@2
|
||||
JNE @@exit_qSortHelp
|
||||
LEA ECX, [EBX+1]
|
||||
MOV EDX, EBX
|
||||
//CALL @@Compare
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
PUSH ECX
|
||||
MOV EAX, [EBP-4]
|
||||
MOV EAX, [EAX + EDX*4]
|
||||
MOV EDX, [EBP-4]
|
||||
MOV EDX, [EDX + ECX*4]
|
||||
CALL dword ptr [EBP-8]
|
||||
POP ECX
|
||||
POP EDX
|
||||
TEST EAX, EAX
|
||||
POP EAX
|
||||
|
||||
JLE @@exit_qSortHelp
|
||||
@@swp_exit:
|
||||
//CALL @@Swap
|
||||
PUSH EAX
|
||||
PUSH ESI
|
||||
MOV ESI, [EBP-4]
|
||||
MOV EAX, [ESI+EDX*4]
|
||||
XCHG EAX, [ESI+ECX*4]
|
||||
MOV [ESI+EDX*4], EAX
|
||||
POP ESI
|
||||
POP EAX
|
||||
|
||||
@@exit_qSortHelp:
|
||||
POP EDI
|
||||
POP ESI
|
||||
POP EBX
|
||||
RET
|
||||
|
||||
// ESI = leftP
|
||||
// EDI = rightP
|
||||
@@2: LEA EDI, [EAX+EBX-1]
|
||||
MOV ESI, EAX
|
||||
SHR ESI, 1
|
||||
ADD ESI, EBX
|
||||
MOV ECX, ESI
|
||||
MOV EDX, EDI
|
||||
CALL @@CompareLeSwap
|
||||
MOV EDX, EBX
|
||||
//CALL @@Compare
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
PUSH ECX
|
||||
MOV EAX, [EBP-4]
|
||||
MOV EAX, [EAX + EDX*4]
|
||||
MOV EDX, [EBP-4]
|
||||
MOV EDX, [EDX + ECX*4]
|
||||
CALL dword ptr [EBP-8]
|
||||
POP ECX
|
||||
POP EDX
|
||||
TEST EAX, EAX
|
||||
POP EAX
|
||||
|
||||
JG @@4
|
||||
//CALL @@Swap
|
||||
PUSH EAX
|
||||
PUSH ESI
|
||||
MOV ESI, [EBP-4]
|
||||
MOV EAX, [ESI+EDX*4]
|
||||
XCHG EAX, [ESI+ECX*4]
|
||||
MOV [ESI+EDX*4], EAX
|
||||
POP ESI
|
||||
POP EAX
|
||||
|
||||
JMP @@5
|
||||
@@4: MOV ECX, EBX
|
||||
MOV EDX, EDI
|
||||
CALL @@CompareLeSwap
|
||||
@@5:
|
||||
CMP EAX, 3
|
||||
JNE @@6
|
||||
MOV EDX, EBX
|
||||
MOV ECX, ESI
|
||||
JMP @@swp_exit
|
||||
@@6: // classic Horae algorithm
|
||||
|
||||
PUSH EAX // EAX = pivotEnd
|
||||
LEA EAX, [EBX+1]
|
||||
MOV ESI, EAX
|
||||
@@repeat:
|
||||
MOV EDX, ESI
|
||||
MOV ECX, EBX
|
||||
//CALL @@Compare
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
PUSH ECX
|
||||
MOV EAX, [EBP-4]
|
||||
MOV EAX, [EAX + EDX*4]
|
||||
MOV EDX, [EBP-4]
|
||||
MOV EDX, [EDX + ECX*4]
|
||||
CALL dword ptr [EBP-8]
|
||||
POP ECX
|
||||
POP EDX
|
||||
TEST EAX, EAX
|
||||
POP EAX
|
||||
|
||||
JG @@while2
|
||||
@@while1:
|
||||
JNE @@7
|
||||
MOV EDX, ESI
|
||||
MOV ECX, EAX
|
||||
//CALL @@Swap
|
||||
PUSH EAX
|
||||
PUSH ESI
|
||||
MOV ESI, [EBP-4]
|
||||
MOV EAX, [ESI+EDX*4]
|
||||
XCHG EAX, [ESI+ECX*4]
|
||||
MOV [ESI+EDX*4], EAX
|
||||
POP ESI
|
||||
POP EAX
|
||||
|
||||
INC EAX
|
||||
@@7:
|
||||
CMP ESI, EDI
|
||||
JGE @@qBreak
|
||||
INC ESI
|
||||
JMP @@repeat
|
||||
@@while2:
|
||||
CMP ESI, EDI
|
||||
JGE @@until
|
||||
MOV EDX, EBX
|
||||
MOV ECX, EDI
|
||||
//CALL @@Compare
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
PUSH ECX
|
||||
MOV EAX, [EBP-4]
|
||||
MOV EAX, [EAX + EDX*4]
|
||||
MOV EDX, [EBP-4]
|
||||
MOV EDX, [EDX + ECX*4]
|
||||
CALL dword ptr [EBP-8]
|
||||
POP ECX
|
||||
POP EDX
|
||||
TEST EAX, EAX
|
||||
POP EAX
|
||||
|
||||
JGE @@8
|
||||
DEC EDI
|
||||
JMP @@while2
|
||||
@@8:
|
||||
MOV EDX, ESI
|
||||
MOV ECX, EDI
|
||||
//PUSHFD
|
||||
//CALL @@Swap
|
||||
PUSH EAX
|
||||
PUSH ESI
|
||||
MOV ESI, [EBP-4]
|
||||
MOV EAX, [ESI+EDX*4]
|
||||
XCHG EAX, [ESI+ECX*4]
|
||||
MOV [ESI+EDX*4], EAX
|
||||
POP ESI
|
||||
POP EAX
|
||||
|
||||
//POPFD
|
||||
JE @@until
|
||||
INC ESI
|
||||
DEC EDI
|
||||
@@until:
|
||||
CMP ESI, EDI
|
||||
JL @@repeat
|
||||
@@qBreak:
|
||||
MOV EDX, ESI
|
||||
MOV ECX, EBX
|
||||
//CALL @@Compare
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
PUSH ECX
|
||||
MOV EAX, [EBP-4]
|
||||
MOV EAX, [EAX + EDX*4]
|
||||
MOV EDX, [EBP-4]
|
||||
MOV EDX, [EDX + ECX*4]
|
||||
CALL dword ptr [EBP-8]
|
||||
POP ECX
|
||||
POP EDX
|
||||
TEST EAX, EAX
|
||||
POP EAX
|
||||
|
||||
JG @@9
|
||||
INC ESI
|
||||
@@9:
|
||||
PUSH EBX // EBX = PivotTemp
|
||||
PUSH ESI // ESI = leftTemp
|
||||
DEC ESI
|
||||
@@while3:
|
||||
CMP EBX, EAX
|
||||
JGE @@while3_break
|
||||
CMP ESI, EAX
|
||||
JL @@while3_break
|
||||
MOV EDX, EBX
|
||||
MOV ECX, ESI
|
||||
//CALL @@Swap
|
||||
PUSH EAX
|
||||
PUSH ESI
|
||||
MOV ESI, [EBP-4]
|
||||
MOV EAX, [ESI+EDX*4]
|
||||
XCHG EAX, [ESI+ECX*4]
|
||||
MOV [ESI+EDX*4], EAX
|
||||
POP ESI
|
||||
POP EAX
|
||||
|
||||
INC EBX
|
||||
DEC ESI
|
||||
JMP @@while3
|
||||
@@while3_break:
|
||||
POP ESI
|
||||
POP EBX
|
||||
|
||||
MOV EDX, EAX
|
||||
POP EAX // EAX = nElem
|
||||
PUSH EDI // EDI = lNum
|
||||
MOV EDI, ESI
|
||||
SUB EDI, EDX
|
||||
ADD EAX, EBX
|
||||
SUB EAX, ESI
|
||||
|
||||
PUSH EBX
|
||||
PUSH EAX
|
||||
CMP EAX, EDI
|
||||
JGE @@10
|
||||
|
||||
MOV EBX, ESI
|
||||
CALL @@qSortHelp
|
||||
POP EAX
|
||||
MOV EAX, EDI
|
||||
POP EBX
|
||||
JMP @@11
|
||||
|
||||
@@10: MOV EAX, EDI
|
||||
CALL @@qSortHelp
|
||||
POP EAX
|
||||
POP EBX
|
||||
MOV EBX, ESI
|
||||
@@11:
|
||||
POP EDI
|
||||
JMP @@TailRecursion
|
||||
|
||||
@@Compare:
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
PUSH ECX
|
||||
MOV EAX, [EBP-4]
|
||||
MOV EAX, [EAX + EDX*4]
|
||||
MOV EDX, [EBP-4]
|
||||
MOV EDX, [EDX + ECX*4]
|
||||
CALL dword ptr [EBP-8]
|
||||
POP ECX
|
||||
POP EDX
|
||||
TEST EAX, EAX
|
||||
POP EAX
|
||||
RET
|
||||
|
||||
@@CompareLeSwap:
|
||||
//CALL @@Compare
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
PUSH ECX
|
||||
MOV EAX, [EBP-4]
|
||||
MOV EAX, [EAX + EDX*4]
|
||||
MOV EDX, [EBP-4]
|
||||
MOV EDX, [EDX + ECX*4]
|
||||
CALL dword ptr [EBP-8]
|
||||
POP ECX
|
||||
POP EDX
|
||||
TEST EAX, EAX
|
||||
POP EAX
|
||||
|
||||
JG @@ret
|
||||
|
||||
@@Swap: PUSH EAX
|
||||
PUSH ESI
|
||||
MOV ESI, [EBP-4]
|
||||
MOV EAX, [ESI+EDX*4]
|
||||
XCHG EAX, [ESI+ECX*4]
|
||||
MOV [ESI+EDX*4], EAX
|
||||
POP ESI
|
||||
//TEST EAX, EAX
|
||||
POP EAX
|
||||
@@ret:
|
||||
RET
|
||||
|
||||
end;
|
||||
|
||||
|
||||
function CompareIntegers( const Sender : Pointer; const e1, e2 : DWORD ) : Integer;
|
||||
asm
|
||||
MOV EDX, [EAX+EDX*4]
|
||||
@ -13330,7 +13422,11 @@ asm
|
||||
@@if32bit:
|
||||
LOOP @@iffin
|
||||
INC EDX
|
||||
{$IFDEF DIBPixels32bitWithAlpha}
|
||||
MOV EAX, offset[_GetDIBPixelsTrueColorAlpha]
|
||||
{$ELSE}
|
||||
MOV EAX, offset[_GetDIBPixelsTrueColor]
|
||||
{$ENDIF}
|
||||
@@iffin:
|
||||
MOV byte ptr [EBX].fPixelMask, DH
|
||||
MOV byte ptr [EBX].fPixelsPerByteMask, DL
|
||||
@ -13556,7 +13652,11 @@ asm
|
||||
@@if32bit:
|
||||
LOOP @@ifend
|
||||
INC EDX
|
||||
MOV EAX, offset[_SetDIBPixelsTrueColorAlpha]
|
||||
{$IFDEF DIBPixels32bitWithAlpha}
|
||||
MOV EAX, offset[_SetDIBPixelsTrueColor]
|
||||
{$ELSE}
|
||||
MOV EAX, offset[_SetDIBPixelsTrueColor]
|
||||
{$ENDIF}
|
||||
@@ifend:
|
||||
MOV byte ptr [EBX].fPixelMask, DH
|
||||
MOV byte ptr [EBX].fPixelsPerByteMask, DL
|
||||
|
||||
@ -498,7 +498,7 @@ begin
|
||||
else
|
||||
RCheck.Top := RCheck.Top + (RCheck.Bottom - RCheck.Top - H) div 2;
|
||||
RCheck.Bottom := RCheck.Top + H;
|
||||
RText := MakeRect(RCheck.Right + Sender.Border, RCheck.Top,
|
||||
RText := MakeRect(RCheck.Right + Sender.fMargin, RCheck.Top,
|
||||
RClient.Right, RCheck.Bottom);
|
||||
// Getting state
|
||||
fState := 1; {CBS_UNCHECKEDNORMAL}
|
||||
@ -561,7 +561,11 @@ begin
|
||||
DeleteObject(F);
|
||||
|
||||
// Draw focusrect
|
||||
if GetFocus = Sender.fHandle then DrawFocusRect(DC, RText);
|
||||
if GetFocus = Sender.fHandle then
|
||||
begin
|
||||
dec( RText.Left );
|
||||
DrawFocusRect(DC, RText);
|
||||
end;
|
||||
end;
|
||||
//************************* Drawing RadioBox control *************************//
|
||||
procedure WndRadioBoxXPDraw( Dummy : Pointer; Sender: PControl; DC: HDC );
|
||||
@ -659,7 +663,11 @@ begin
|
||||
DeleteObject(F);
|
||||
|
||||
// Draw focusrect
|
||||
if GetFocus = Sender.fHandle then DrawFocusRect(DC, RText);
|
||||
if GetFocus = Sender.fHandle then
|
||||
begin
|
||||
dec( RText.Left );
|
||||
DrawFocusRect(DC, RText);
|
||||
end;
|
||||
end;
|
||||
|
||||
//******************** Drawing Button and BitButton control ******************//
|
||||
|
||||
Loading…
Reference in New Issue
Block a user