3j
git-svn-id: https://svn.code.sf.net/p/kolmck/code@79 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
parent
19cb111bcd
commit
c23311e816
@ -1,3 +1,5 @@
|
||||
{This version is compatible with KOL 3.00+ -- VK}
|
||||
|
||||
unit ActiveKOL;
|
||||
|
||||
interface
|
||||
@ -9,9 +11,11 @@ uses
|
||||
{$IFDEF _D6orHigher}
|
||||
//{$WARN SYMBOL_DEPRECATED OFF}
|
||||
{$WARN SYMBOL_PLATFORM OFF}
|
||||
{$IFDEF _D7orHigher}
|
||||
{$WARN UNSAFE_TYPE OFF}
|
||||
{$WARN UNSAFE_CAST OFF}
|
||||
{$WARN UNSAFE_CODE OFF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF _D5orHigher}
|
||||
@ -215,13 +219,15 @@ type
|
||||
procedure DestroyStorage;
|
||||
procedure DestroyControl;
|
||||
procedure StandardEvent(DispID: TDispID; var Params: TDispParams);
|
||||
procedure SetMouseDblClk(const Value: TOnMouse);
|
||||
//procedure SetMouseDblClk(const Value: TOnMouse);
|
||||
procedure SetOnChar(const Value: TOnChar);
|
||||
protected
|
||||
{$IFDEF DELPHI_CODECOMPLETION_BUG}
|
||||
//{$IFDEF DELPHI_CODECOMPLETION_BUG}
|
||||
fNotAvailable: Boolean;
|
||||
{$ENDIF}
|
||||
//{$ENDIF}
|
||||
{$IFNDEF USE_NAMES}
|
||||
fName: String;
|
||||
{$ENDIF}
|
||||
FControlData: PControlData;
|
||||
FOleObject: IOleObject;
|
||||
FMiscStatus: Longint;
|
||||
@ -337,8 +343,12 @@ type
|
||||
procedure MouseUp(Button: TMouseButton; AShift: DWORD;
|
||||
X, Y: Integer);
|
||||
|
||||
property OnKeyPress: TOnChar read fOnChar write SetOnChar;
|
||||
property OnDblClick: TOnMouse read fOnMouseDblClk write SetMouseDblClk;
|
||||
property OnKeyPress: TOnChar
|
||||
read {$IFDEF EVENTS_DYNAMIC} Get_OnChar {$ELSE} EV.fOnChar {$ENDIF}
|
||||
write SetOnChar;
|
||||
property OnDblClick: TOnMouse index idx_fOnMouseDblClk
|
||||
read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseDblClk {$ENDIF}
|
||||
write SetOnMouseEvent; // SetMouseDblClk;
|
||||
|
||||
destructor Destroy; virtual;
|
||||
|
||||
@ -509,7 +519,7 @@ constructor TEnumPropDesc.Create(DispID, ValueCount: Integer;
|
||||
var
|
||||
I: Integer;
|
||||
VarDesc: PVarDesc;
|
||||
Name: WideString;
|
||||
XName: WideString;
|
||||
begin
|
||||
FDispID := DispID;
|
||||
FValueCount := ValueCount;
|
||||
@ -518,12 +528,12 @@ begin
|
||||
begin
|
||||
OleCheck(TypeInfo.GetVarDesc(I, VarDesc));
|
||||
try
|
||||
OleCheck(TypeInfo.GetDocumentation(VarDesc^.memid, @Name,
|
||||
OleCheck(TypeInfo.GetDocumentation(VarDesc^.memid, @XName,
|
||||
nil, nil, nil));
|
||||
with FValues^[I] do
|
||||
begin
|
||||
Value := TVarData(VarDesc^.lpVarValue^).VInteger;
|
||||
Ident := Name;
|
||||
Ident := XName;
|
||||
while (Length(Ident) > 1) and (Ident[1] = '_') do
|
||||
Delete(Ident, 1, 1);
|
||||
end;
|
||||
@ -825,7 +835,9 @@ begin
|
||||
if FOleInPlaceObject = nil then
|
||||
raise EOleError.CreateResFmt(e_Ole, Integer( @SCannotActivate ), [nil]);
|
||||
HookControlWndProc;
|
||||
if not fVisible and IsWindowVisible(fHandle) then
|
||||
if {$IFDEF USE_FLAGS} not(F3_Visible in fStyle.f3_Style)
|
||||
{$ELSE} not fVisible {$ENDIF}
|
||||
and IsWindowVisible(fHandle) then
|
||||
ShowWindow(fHandle, SW_HIDE);
|
||||
Result := TRUE;
|
||||
end
|
||||
@ -939,7 +951,9 @@ procedure TOleCtl.DblClk;
|
||||
var MouseData: TMouseEventData;
|
||||
P: TPoint;
|
||||
begin
|
||||
if Assigned(OnMouseDblClk) then
|
||||
{$IFDEF NIL_EVENTS}
|
||||
if Assigned(EV.fOnMouseDblClk) then
|
||||
{$ENDIF}
|
||||
begin
|
||||
MouseData.Button := mbLeft;
|
||||
MouseData.Shift := 0;
|
||||
@ -947,7 +961,7 @@ begin
|
||||
P := Screen2Client( P );
|
||||
MouseData.X := P.x;
|
||||
MouseData.Y := P.y;
|
||||
OnMouseDblClk(@Self, MouseData);
|
||||
EV.fOnMouseDblClk(@Self, MouseData);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1322,8 +1336,9 @@ begin
|
||||
// overriding this method, we allow for constructor to initialize
|
||||
// the object.
|
||||
fControlClassName := 'OleCtl'; // ClassName
|
||||
fIsControl := TRUE;
|
||||
fStyle := WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or
|
||||
{$IFDEF USE_FLAGS} include( fFlagsG3, G3_IsControl );
|
||||
{$ELSE} fIsControl := TRUE; {$ENDIF}
|
||||
fStyle.Value := WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or
|
||||
WS_CHILD; // or WS_BORDER or WS_THICKFRAME;
|
||||
|
||||
//AttachProc( WndProcCtrl ); for test only
|
||||
@ -1366,7 +1381,8 @@ begin
|
||||
OleCheck(FOleObject.SetClientSite(fOleCtlIntf));
|
||||
OleCheck(FOleObject.QueryInterface(IPersistStreamInit, FPersistStream));
|
||||
if FMiscStatus and OLEMISC_INVISIBLEATRUNTIME <> 0 then
|
||||
fVisible := False;
|
||||
{$IFDEF USE_FLAGS} exclude( fStyle.f3_Style, F3_Visible );
|
||||
{$ELSE} fVisible := False; {$ENDIF}
|
||||
{if FMiscStatus and OLEMISC_SIMPLEFRAME <> 0 then
|
||||
ControlStyle := [csAcceptsControls, csDoubleClicks, csNoStdEvents] else
|
||||
ControlStyle := [csDoubleClicks, csNoStdEvents];}
|
||||
@ -1451,17 +1467,17 @@ end;
|
||||
|
||||
procedure TOleCtl.KeyDown(var Key: Longint; AShift: DWORD);
|
||||
begin
|
||||
if Assigned(FOnKeyDown) then FOnKeyDown(@Self, Key, AShift);
|
||||
if Assigned(EV.fOnKeyDown) then EV.fOnKeyDown(@Self, Key, AShift);
|
||||
end;
|
||||
|
||||
procedure TOleCtl.KeyPress(var Key: KOLChar);
|
||||
begin
|
||||
if Assigned(FOnChar) then FOnChar(@Self, Key, 0);
|
||||
if Assigned(EV.fOnChar) then EV.fOnChar(@Self, Key, 0);
|
||||
end;
|
||||
|
||||
procedure TOleCtl.KeyUp(var Key: Longint; AShift: DWORD);
|
||||
begin
|
||||
if Assigned(FOnKeyUp) then FOnKeyUp(@Self, Key, AShift);
|
||||
if Assigned(EV.fOnKeyUp) then EV.fOnKeyUp(@Self, Key, AShift);
|
||||
end;
|
||||
|
||||
procedure TOleCtl.MouseDown(Button: TMouseButton; AShift: DWORD; X,
|
||||
@ -1545,10 +1561,11 @@ begin
|
||||
SetProperty(Index, Temp);
|
||||
end;
|
||||
|
||||
procedure TOleCtl.SetMouseDblClk(const Value: TOnMouse);
|
||||
(*procedure TOleCtl.SetMouseDblClk(const Value: TOnMouse);
|
||||
begin
|
||||
fOnMouseDblClk := Value;
|
||||
end;
|
||||
{$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
|
||||
.fOnMouseDblClk := Value;
|
||||
end;*)
|
||||
|
||||
procedure TOleCtl.SetName(const Value: String);
|
||||
var
|
||||
@ -1603,7 +1620,8 @@ end;
|
||||
|
||||
procedure TOleCtl.SetOnChar(const Value: TOnChar);
|
||||
begin
|
||||
fOnChar := Value;
|
||||
{$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
|
||||
.fOnChar := Value;
|
||||
end;
|
||||
|
||||
procedure TOleCtl.SetOnLeave(const Value: TOnEvent);
|
||||
@ -1740,13 +1758,13 @@ begin
|
||||
(Form.ActiveOleControl <> Self) then
|
||||
Form.ActiveOleControl.Perform(CM_UIDEACTIVATE, 0, 0);
|
||||
Form.ActiveOleControl := Self;}
|
||||
if (Form.fCurrentControl <> nil) and
|
||||
(Form.fCurrentControl <> @Self) then
|
||||
Form.fCurrentControl.Perform(CM_UIDEACTIVATE, 0, 0);
|
||||
Form.fCurrentControl := @Self;
|
||||
if (Form.DF.fCurrentControl <> nil) and
|
||||
(Form.DF.fCurrentControl <> @Self) then
|
||||
Form.DF.fCurrentControl.Perform(CM_UIDEACTIVATE, 0, 0);
|
||||
Form.DF.fCurrentControl := @Self;
|
||||
end else
|
||||
if Form.fCurrentControl = @Self then
|
||||
Form.fCurrentControl := nil;
|
||||
if Form.DF.fCurrentControl = @Self then
|
||||
Form.DF.fCurrentControl := nil;
|
||||
end;
|
||||
|
||||
procedure TOleCtl.SetVariantProp(Index: Integer; const Value: Variant);
|
||||
@ -1856,11 +1874,19 @@ begin
|
||||
DISPID_KEYPRESS:
|
||||
if Params.cArgs > 0 then
|
||||
begin
|
||||
Ch := Char(Integer(Variant(Args^[0])));
|
||||
Ch := KOLChar(Integer(Variant(Args^[0])));
|
||||
KeyPress(Ch);
|
||||
if ((Args^[0].vType and varByRef) <> 0) then
|
||||
Char(Args^[0].VPointer^) := Ch;
|
||||
KOLChar(Args^[0].VPointer^) := Ch;
|
||||
end;
|
||||
{DISPID_KEYPRESS:
|
||||
if Params.cArgs > 0 then
|
||||
begin
|
||||
Ch := KOLChar(Integer(Variant(Args^[0])));
|
||||
KeyPress(Ch);
|
||||
if ((Args^[0].vType and varByRef) <> 0) then
|
||||
KOLChar(Args^[0].VPointer^) := Ch;
|
||||
end;}
|
||||
DISPID_MOUSEDOWN, DISPID_MOUSEMOVE, DISPID_MOUSEUP:
|
||||
if Params.cArgs >= 4 then
|
||||
begin
|
||||
|
174
KOL.pas
174
KOL.pas
@ -14,7 +14,7 @@
|
||||
Key Objects Library (C) 2000 by Kladov Vladimir.
|
||||
|
||||
****************************************************************
|
||||
* VERSION 3.00.i
|
||||
* VERSION 3.00.j
|
||||
****************************************************************
|
||||
|
||||
K.O.L. - is a set of objects to create small programs
|
||||
@ -581,7 +581,15 @@ interface
|
||||
{$UNDEF SPEED_FASTER}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
{$IFDEF SAFE_CODE}
|
||||
{$UNDEF NO_SAFE_CODE}
|
||||
{$ENDIF}
|
||||
{$IFDEF NO_SAFE_CODE}
|
||||
{$UNDEF SAFE_CODE}
|
||||
{$ENDIF}
|
||||
{$IFnDEF NO_SAFE_CODE}
|
||||
{$DEFINE SAFE_CODE}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF NOT_USE_RICHEDIT}
|
||||
{$DEFINE NOT_UNLOAD_RICHEDITLIB}
|
||||
@ -11153,10 +11161,7 @@ function MulDiv( A, B, C: Integer ): Integer;
|
||||
{* }
|
||||
function MakeDateTimeRange( D1, D2: TDateTime ): TDateTimeRange;
|
||||
{* Returns TDateTimeRange from two TDateTime bounds. }
|
||||
//[Integer FUNCTIONS DECLARATIONS]
|
||||
procedure Swap( var X, Y: Integer ); overload;
|
||||
procedure Swap(var X, Y: Byte); overload;
|
||||
procedure Swap(var X, Y: String); overload;
|
||||
procedure Swap( var X, Y: Integer );
|
||||
{* exchanging values }
|
||||
function Min( X, Y: Integer ): Integer;
|
||||
{* minimum of two integers }
|
||||
@ -11190,12 +11195,12 @@ function UInt2Str( Value: DWORD ): AnsiString;
|
||||
function Int2StrEx( Value, MinWidth: Integer ): AnsiString;
|
||||
{* Like Int2Str, but resulting string filled with leading spaces to provide
|
||||
at least MinWidth characters. }
|
||||
function Int2Rome( Value: Integer ): AnsiString;
|
||||
function Int2Rome( Value: Integer ): KOLString;
|
||||
{* Represents number 1..8999 to Rome numer. }
|
||||
function Int2Ths( I : Integer ) : AnsiString;
|
||||
function Int2Ths( I: Integer ): KOLString;
|
||||
{* Converts integer into string, separating every three digits from each
|
||||
other by character ThsSeparator. (Convert to thousands). You }
|
||||
function Int2Digs( Value, Digits : Integer ) : AnsiString;
|
||||
function Int2Digs( Value, Digits: Integer ): KOLString;
|
||||
{* Converts integer to string, inserting necessary number of leading zeroes
|
||||
to provide desired length of string, given by Digits parameter. If
|
||||
resulting string is greater then Digits, string is not truncated anyway. }
|
||||
@ -15044,7 +15049,7 @@ end;
|
||||
function MsgBox( const S: KOLString; Flags: DWORD ): DWORD;
|
||||
var Title: PKOLChar;
|
||||
begin
|
||||
{$IFDEF SAFE_CODE} // MsgBox should be called when Applet already created
|
||||
{$IFnDEF NO_SAFE_CODE} // MsgBox should be called when Applet already created
|
||||
Title := nil; // (and yet not destroyed)
|
||||
if assigned( Applet ) then
|
||||
{$ENDIF}
|
||||
@ -15062,7 +15067,7 @@ begin
|
||||
{$ENDIF}
|
||||
Result := MessageBox( 0, PKOLChar( S ), Title, Flags );
|
||||
{$IFDEF SNAPMOUSE2DFLTBTN}
|
||||
{$IFDEF SAFE_CODE}
|
||||
{$IFnDEF NO_SAFE_CODE}
|
||||
if Assigned( Applet ) then
|
||||
{$ENDIF}
|
||||
Applet.DetachProc( WndProcSnapMouse2DfltBtn );
|
||||
@ -15331,7 +15336,7 @@ begin
|
||||
Result.ToDate := D2;
|
||||
end;
|
||||
|
||||
procedure Swap( var X, Y: Integer ); overload;
|
||||
procedure Swap( var X, Y: Integer );
|
||||
{$IFDEF F_P}
|
||||
var Tmp: Integer;
|
||||
begin
|
||||
@ -15347,24 +15352,6 @@ asm
|
||||
end;
|
||||
{$ENDIF F_P/DELPHI}
|
||||
|
||||
procedure Swap(var X, Y: Byte); overload;
|
||||
var
|
||||
T: Byte;
|
||||
begin
|
||||
T := X;
|
||||
X := Y;
|
||||
Y := T;
|
||||
end;
|
||||
|
||||
procedure Swap(var X, Y: String); overload;
|
||||
var
|
||||
T: String;
|
||||
begin
|
||||
T := X;
|
||||
X := Y;
|
||||
Y := T;
|
||||
end;
|
||||
|
||||
function Min( X, Y: Integer ): Integer;
|
||||
asm
|
||||
{$IFDEF F_P}
|
||||
@ -20396,16 +20383,16 @@ begin
|
||||
Result := ' ' + Result;
|
||||
end;
|
||||
|
||||
function Int2Rome( Value: Integer ): AnsiString;
|
||||
const RomeDigs = AnsiString('IVXLCDMT');
|
||||
function RomeNum( N, FromIdx: Integer ): AnsiString;
|
||||
function Int2Rome( Value: Integer ): KOLString;
|
||||
const RomeDigs = KOLString('IVXLCDMT');
|
||||
function RomeNum( N, FromIdx: Integer ): KOLString;
|
||||
begin
|
||||
CASE N OF
|
||||
1, 2, 3: Result := StrRepeat( RomeDigs[ FromIdx ], N );
|
||||
4: Result := RomeDigs[ FromIdx ] + RomeDigs[ FromIdx + 1 ];
|
||||
4: Result := '' + RomeDigs[ FromIdx ] + RomeDigs[ FromIdx + 1 ];
|
||||
5, 6, 7, 8: Result := RomeDigs[ FromIdx + 1 ] + StrRepeat( RomeDigs[ FromIdx ],
|
||||
N - 5 );
|
||||
9: Result := RomeDigs[ FromIdx ] + RomeDigs[ FromIdx + 2 ]
|
||||
9: Result := '' + RomeDigs[ FromIdx ] + RomeDigs[ FromIdx + 2 ]
|
||||
else Result := '';
|
||||
END;
|
||||
end;
|
||||
@ -20425,8 +20412,67 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal
|
||||
{$IFDEF ASM_UNICODE}
|
||||
function Int2Ths( I : Integer ) : AnsiString;
|
||||
asm
|
||||
PUSH EBP
|
||||
MOV EBP, ESP
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
CALL Int2Str
|
||||
POP EDX
|
||||
POP EAX
|
||||
TEST EAX, EAX
|
||||
JGE @@0
|
||||
NEG EAX
|
||||
@@0:
|
||||
CMP EAX, 1000
|
||||
JL @@Exit
|
||||
PUSH EDX
|
||||
MOV EAX, [EDX]
|
||||
PUSH EAX
|
||||
CALL System.@LStrLen // EAX = Length(Result)
|
||||
POP EDX
|
||||
PUSH EDX // EDX = @Result[ 1 ]
|
||||
XOR ECX, ECX
|
||||
|
||||
@@1:
|
||||
ROL ECX, 8
|
||||
DEC EAX
|
||||
MOV CL, [EDX+EAX]
|
||||
JZ @@fin
|
||||
CMP ECX, 300000h
|
||||
JL @@1
|
||||
|
||||
PUSH ECX
|
||||
XOR ECX, ECX
|
||||
MOV CL, [ThsSeparator]
|
||||
JMP @@1
|
||||
|
||||
@@fin: CMP CL, '-'
|
||||
JNE @@fin1
|
||||
CMP CH, [ThsSeparator]
|
||||
JNE @@fin1
|
||||
MOV CH, 0 // this corrects -,ddd,...
|
||||
@@fin1: CMP ECX, 01000000h
|
||||
JGE @@fin2
|
||||
INC EAX
|
||||
ROL ECX, 8
|
||||
JMP @@fin1
|
||||
@@fin2: PUSH ECX
|
||||
|
||||
LEA EDX, [ESP+EAX]
|
||||
MOV EAX, [EBP-4]
|
||||
{$IFDEF _D2009orHigher}
|
||||
XOR ECX, ECX // TODO: safe to change ecx?
|
||||
{$ENDIF}
|
||||
CALL System.@LStrFromPChar
|
||||
@@Exit:
|
||||
MOV ESP, EBP
|
||||
POP EBP
|
||||
end;
|
||||
{$ELSE ASM_VERSION}
|
||||
function Int2Ths( I : Integer ): KOLString;
|
||||
var S : AnsiString;
|
||||
begin
|
||||
S := Int2Str( I );
|
||||
@ -20443,9 +20489,59 @@ begin
|
||||
end;
|
||||
{$ENDIF ASM_VERSION}
|
||||
|
||||
{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal
|
||||
function Int2Digs( Value, Digits : Integer ) : AnsiString;
|
||||
var M : AnsiString;
|
||||
{$IFDEF ASM_UNICODE}
|
||||
function Int2Digs( Value, Digits : Integer ) : KOLString;
|
||||
asm
|
||||
PUSH EBP
|
||||
MOV EBP, ESP
|
||||
PUSH EDX // [EBP-4] = Digits
|
||||
PUSH ECX
|
||||
MOV EDX, ECX
|
||||
CALL Int2Str
|
||||
POP ECX
|
||||
PUSH ECX // [EBP-8] = @Result
|
||||
MOV EAX, [ECX]
|
||||
PUSH EAX
|
||||
CALL System.@LStrLen
|
||||
POP EDX // EDX = @Result[1]
|
||||
MOV ECX, EAX // ECX = Length( Result )
|
||||
ADD EAX, EAX
|
||||
SUB ESP, EAX
|
||||
MOV EAX, ESP
|
||||
PUSHAD
|
||||
CALL StrCopy
|
||||
POPAD
|
||||
MOV EDX, EAX
|
||||
ADD ESP, -100
|
||||
CMP byte ptr [EDX], '-'
|
||||
PUSHFD
|
||||
JNE @@1
|
||||
INC EDX
|
||||
@@1:
|
||||
MOV EAX, [EBP-4] // EAX = Digits
|
||||
CMP ECX, EAX
|
||||
JGE @@2
|
||||
DEC EDX
|
||||
MOV byte ptr [EDX], '0'
|
||||
INC ECX
|
||||
JMP @@1
|
||||
@@2:
|
||||
POPFD
|
||||
JNE @@3
|
||||
DEC EDX
|
||||
MOV byte ptr [EDX], '-'
|
||||
@@3:
|
||||
MOV EAX, [EBP-8]
|
||||
{$IFDEF _D2009orHigher}
|
||||
XOR ECX, ECX // TODO: eax or ecx affect result?
|
||||
{$ENDIF}
|
||||
CALL System.@LStrFromPChar
|
||||
MOV ESP, EBP
|
||||
POP EBP
|
||||
end;
|
||||
{$ELSE ASM_VERSION} //Pascal
|
||||
function Int2Digs( Value, Digits : Integer ) : KOLString;
|
||||
var M : KOLString;
|
||||
begin
|
||||
Result := Int2Str( Value );
|
||||
M := '';
|
||||
|
109
KOL_ASM.inc
109
KOL_ASM.inc
@ -2407,115 +2407,6 @@ asm
|
||||
@@exit:
|
||||
end;
|
||||
|
||||
function Int2Ths( I : Integer ) : AnsiString;
|
||||
asm
|
||||
PUSH EBP
|
||||
MOV EBP, ESP
|
||||
PUSH EAX
|
||||
PUSH EDX
|
||||
CALL Int2Str
|
||||
POP EDX
|
||||
POP EAX
|
||||
TEST EAX, EAX
|
||||
JGE @@0
|
||||
NEG EAX
|
||||
@@0:
|
||||
CMP EAX, 1000
|
||||
JL @@Exit
|
||||
PUSH EDX
|
||||
MOV EAX, [EDX]
|
||||
PUSH EAX
|
||||
CALL System.@LStrLen // EAX = Length(Result)
|
||||
POP EDX
|
||||
PUSH EDX // EDX = @Result[ 1 ]
|
||||
XOR ECX, ECX
|
||||
|
||||
@@1:
|
||||
ROL ECX, 8
|
||||
DEC EAX
|
||||
MOV CL, [EDX+EAX]
|
||||
JZ @@fin
|
||||
CMP ECX, 300000h
|
||||
JL @@1
|
||||
|
||||
PUSH ECX
|
||||
XOR ECX, ECX
|
||||
MOV CL, [ThsSeparator]
|
||||
JMP @@1
|
||||
|
||||
@@fin: CMP CL, '-'
|
||||
JNE @@fin1
|
||||
CMP CH, [ThsSeparator]
|
||||
JNE @@fin1
|
||||
MOV CH, 0 // this corrects -,ddd,...
|
||||
@@fin1: CMP ECX, 01000000h
|
||||
JGE @@fin2
|
||||
INC EAX
|
||||
ROL ECX, 8
|
||||
JMP @@fin1
|
||||
@@fin2: PUSH ECX
|
||||
|
||||
LEA EDX, [ESP+EAX]
|
||||
MOV EAX, [EBP-4]
|
||||
{$IFDEF _D2009orHigher}
|
||||
XOR ECX, ECX // TODO: safe to change ecx?
|
||||
{$ENDIF}
|
||||
CALL System.@LStrFromPChar
|
||||
@@Exit:
|
||||
MOV ESP, EBP
|
||||
POP EBP
|
||||
end;
|
||||
|
||||
function Int2Digs( Value, Digits : Integer ) : AnsiString;
|
||||
asm
|
||||
PUSH EBP
|
||||
MOV EBP, ESP
|
||||
PUSH EDX // [EBP-4] = Digits
|
||||
PUSH ECX
|
||||
MOV EDX, ECX
|
||||
CALL Int2Str
|
||||
POP ECX
|
||||
PUSH ECX // [EBP-8] = @Result
|
||||
MOV EAX, [ECX]
|
||||
PUSH EAX
|
||||
CALL System.@LStrLen
|
||||
POP EDX // EDX = @Result[1]
|
||||
MOV ECX, EAX // ECX = Length( Result )
|
||||
ADD EAX, EAX
|
||||
SUB ESP, EAX
|
||||
MOV EAX, ESP
|
||||
PUSHAD
|
||||
CALL StrCopy
|
||||
POPAD
|
||||
MOV EDX, EAX
|
||||
ADD ESP, -100
|
||||
CMP byte ptr [EDX], '-'
|
||||
PUSHFD
|
||||
JNE @@1
|
||||
INC EDX
|
||||
@@1:
|
||||
MOV EAX, [EBP-4] // EAX = Digits
|
||||
CMP ECX, EAX
|
||||
JGE @@2
|
||||
DEC EDX
|
||||
MOV byte ptr [EDX], '0'
|
||||
INC ECX
|
||||
JMP @@1
|
||||
@@2:
|
||||
POPFD
|
||||
JNE @@3
|
||||
DEC EDX
|
||||
MOV byte ptr [EDX], '-'
|
||||
@@3:
|
||||
MOV EAX, [EBP-8]
|
||||
{$IFDEF _D2009orHigher}
|
||||
XOR ECX, ECX // TODO: eax or ecx affect result?
|
||||
{$ENDIF}
|
||||
CALL System.@LStrFromPChar
|
||||
MOV ESP, EBP
|
||||
POP EBP
|
||||
end;
|
||||
|
||||
function Num2Bytes( Value : Double ) : AnsiString;
|
||||
asm
|
||||
PUSH EBX
|
||||
|
Loading…
Reference in New Issue
Block a user