3j

git-svn-id: https://svn.code.sf.net/p/kolmck/code@79 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07

Addons/ActiveKOL.pas

@@ -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 OnKeyPress: TOnChar
-    property OnDblClick: TOnMouse read fOnMouseDblClk write SetMouseDblClk;
+             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,8 +835,10 @@ 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)
-        ShowWindow(fHandle, SW_HIDE);
+          {$ELSE} not fVisible {$ENDIF}
+      and IsWindowVisible(fHandle) then
+          ShowWindow(fHandle, SW_HIDE);
       Result := TRUE;
     end
       else
@@ -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,9 +1336,10 @@ begin
   // overriding this method, we allow for constructor to initialize
   // the object.
   fControlClassName := 'OleCtl'; // ClassName
-  fIsControl := TRUE;
+  {$IFDEF USE_FLAGS} include( fFlagsG3, G3_IsControl );
-  fStyle := WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or
+  {$ELSE} fIsControl := TRUE; {$ENDIF}
-            WS_CHILD; // or WS_BORDER or WS_THICKFRAME;
+  fStyle.Value := WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or
+      WS_CHILD; // or WS_BORDER or WS_THICKFRAME;
 
   //AttachProc( WndProcCtrl ); for test only
 
@@ -1365,8 +1380,9 @@ begin
       ((FControlData^.Reserved and cdForceSetClientSite) <> 0) then
       OleCheck(FOleObject.SetClientSite(fOleCtlIntf));
   OleCheck(FOleObject.QueryInterface(IPersistStreamInit, FPersistStream));
-  if FMiscStatus and OLEMISC_INVISIBLEATRUNTIME <> 0 then
+  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;
+  {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF}
-end;
+  .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);
@@ -1733,20 +1751,20 @@ var
                  // - to access its protected fields
 begin
   Form := POleCtl( ParentForm );
-  if Form <> nil then
+  if  Form <> nil then
-    if Active then
+      if  Active then
-    begin
+      begin
-      {if (Form.ActiveOleControl <> nil) and
+          {if (Form.ActiveOleControl <> nil) and
-        (Form.ActiveOleControl <> Self) then
+            (Form.ActiveOleControl <> Self) then
-        Form.ActiveOleControl.Perform(CM_UIDEACTIVATE, 0, 0);
+            Form.ActiveOleControl.Perform(CM_UIDEACTIVATE, 0, 0);
-      Form.ActiveOleControl := Self;}
+          Form.ActiveOleControl := Self;}
-      if (Form.fCurrentControl <> nil) and
+          if  (Form.DF.fCurrentControl <> nil) and
-        (Form.fCurrentControl <> @Self) then
+              (Form.DF.fCurrentControl <> @Self) then
-        Form.fCurrentControl.Perform(CM_UIDEACTIVATE, 0, 0);
+              Form.DF.fCurrentControl.Perform(CM_UIDEACTIVATE, 0, 0);
-      Form.fCurrentControl := @Self;
+          Form.DF.fCurrentControl := @Self;
-    end else
+      end else
-      if Form.fCurrentControl = @Self then
+          if  Form.DF.fCurrentControl = @Self then
-        Form.fCurrentControl := nil;
+              Form.DF.fCurrentControl := nil;
 end;
 
 procedure TOleCtl.SetVariantProp(Index: Integer; const Value: Variant);
@@ -1854,13 +1872,21 @@ begin
             Word(Args^[1].VPointer^) := Key;
         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_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;
+        end;}
       DISPID_MOUSEDOWN, DISPID_MOUSEMOVE, DISPID_MOUSEUP:
         if Params.cArgs >= 4 then
         begin

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 );
-   procedure Swap( var X, Y: Integer ); overload;
-   procedure Swap(var X, Y: Byte); overload;
-   procedure Swap(var X, Y: String); overload;
    {* 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;
+function Int2Rome( Value: Integer ): KOLString;
-const RomeDigs = AnsiString('IVXLCDMT');
+const RomeDigs = KOLString('IVXLCDMT');
-  function RomeNum( N, FromIdx: Integer ): AnsiString;
+  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
+{$IFDEF ASM_UNICODE}
-function Int2Digs( Value, Digits : Integer ) : AnsiString;
+function Int2Digs( Value, Digits : Integer ) : KOLString;
-var M : 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;
+{$ELSE ASM_VERSION} //Pascal
+function Int2Digs( Value, Digits : Integer ) : KOLString;
+var M : KOLString;
 begin
   Result := Int2Str( Value );
   M := '';

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