3.00.G

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

KOL.pas

@@ -14,7 +14,7 @@
   Key Objects Library (C) 2000 by Kladov Vladimir.
 
 ****************************************************************
-* VERSION 3.00.F
+* VERSION 3.00.G
 ****************************************************************
 
   K.O.L. - is a set of objects to create small programs
@@ -19882,11 +19882,94 @@ asm
 end;
 {$ENDIF}
 
-{$IFDEF ASM_UNICODE}{$ELSE ASM_VERSION} //Pascal (mixed)
+{$IFDEF ASM_UNICODE}
+function Int2Hex( Value : DWord; Digits : Integer ) : KOLString;
+asm     // EAX = Value
+        // EDX = Digits
+        // ECX = @Result
+
+        PUSH      0
+        ADD       ESP, -0Ch
+
+        PUSH      EDI
+        PUSH      ECX
+
+        LEA       EDI, [ESP+8+0Fh]  // EBX := @Buf[ 15 ]
+        {$IFDEF SMALLEST_CODE}
+        {$ELSE}
+        AND       EDX, $F
+        {$ENDIF}
+
+@@loop: DEC       EDI
+        DEC       EDX
+
+        PUSH      EAX
+        {$IFDEF PARANOIA} DB $24, $0F {$ELSE} AND AL, 0Fh {$ENDIF}
+
+        {$IFDEF oldcode}
+
+                {$IFDEF PARANOIA} DB $3C, 9 {$ELSE} CMP AL, 9 {$ENDIF}
+                JA        @@10
+                {$IFDEF PARANOIA} DB $04, 30h-41h+0Ah {$ELSE} ADD AL,30h-41h+0Ah {$ENDIF}
+        @@10:
+                {$IFDEF PARANOIA} DB $04, 41h-0Ah {$ELSE} ADD AL,41h-0Ah {$ENDIF}
+
+        {$ELSE newcode}
+
+                AAM
+                DB $D5, $11 //AAD
+                ADD      AL, $30
+
+        {$ENDIF newcode}
+
+
+        //MOV       byte ptr [EDI], AL
+        STOSB
+        DEC       EDI
+        POP       EAX
+        SHR       EAX, 4
+
+        JNZ       @@loop
+
+        TEST      EDX, EDX
+        JG        @@loop
+
+        POP       EAX      // EAX = @Result
+        MOV       EDX, EDI // EDX = @resulting string
+        {$IFDEF _D2009orHigher}
+        //PUSH     ECX       // TODO: remove ecx protection
+        XOR      ECX, ECX
+        {$ENDIF}
+        CALL      System.@LStrFromPChar
+        {$IFDEF _D2009orHigher}
+        //POP       ECX      // ECX popup twice to eax?
+        {$ENDIF}
+        POP       EDI
+        ADD       ESP, 10h
+
+{== by KSer - to test it only.
+function Int2Hex( Value : DWord; Digits : Integer ) : shortString;
+asm
+        MOV       [ECX], DL
+        XADD      EDX, ECX
+@@loop1:
+        PUSH      EAX
+        db   $24, $0F    // and  al,$0F
+        AAM
+        DB $D5, $11      // AAD
+        db   $04, $30    // add  al,$30
+        MOV       [EDX], AL
+        POP       EAX
+        SHR       EAX, 4
+        DEC       EDX
+        LOOP      @@loop1
+}
+end;
+{$ELSE ASM_VERSION}
 function Int2Hex( Value : DWord; Digits : Integer ) : KOLString;
 const
   HexDigitChr: array[ 0..15 ] of KOLChar = ( '0','1','2','3','4','5','6','7',
-                                              '8','9','A','B','C','D','E','F' );
+                                             '8','9','A','B','C','D','E','F' );
 var Buf: array[ 0..8 ] of KOLChar;
     Dest : PKOLChar;
 begin
@@ -19906,7 +19989,43 @@ begin
 end;
 {$ENDIF ASM_VERSION}
 
-{$IFDEF ASM_UNICODE}{$ELSE ASM_VERSION} //Pascal
+{$IFDEF ASM_UNICODE}
+function Hex2Int( const Value : AnsiString) : Integer;
+asm
+        CALL     EAX2PChar
+        PUSH     ESI
+        XCHG     ESI, EAX
+        XOR      EDX, EDX
+        TEST     ESI, ESI
+        JE       @@exit
+        LODSB
+        {$IFDEF PARANOIA} DB $3C, '$' {$ELSE} CMP AL, '$' {$ENDIF}
+        JNE      @@1
+@@0:    LODSB
+@@1:    TEST     AL, AL
+        JE       @@exit
+        {$IFDEF PARANOIA} DB $2C, '0' {$ELSE} SUB AL, '0' {$ENDIF}
+        {$IFDEF PARANOIA} DB $3C, 9 {$ELSE} CMP AL, '9' - '0' {$ENDIF}
+        JBE      @@3
+
+        {$IFDEF PARANOIA} DB $2C, $11 {$ELSE} SUB AL, 'A' - '0' {$ENDIF}
+        {$IFDEF PARANOIA} DB $3C, 5 {$ELSE} CMP AL, 'F' - 'A' {$ENDIF}
+        JBE      @@2
+
+        {$IFDEF PARANOIA} DB $2C, 32 {$ELSE} SUB AL, 32 {$ENDIF}
+        {$IFDEF PARANOIA} DB $3C, 5 {$ELSE} CMP AL, 'F' - 'A' {$ENDIF}
+        JA       @@exit
+@@2:
+        {$IFDEF PARANOIA} DB $04, 0Ah {$ELSE} ADD AL, 0Ah {$ENDIF}
+@@3:
+        SHL      EDX, 4
+        ADD      DL, AL
+        JMP      @@0
+
+@@exit: XCHG     EAX, EDX
+        POP      ESI
+end;
+{$ELSE ASM_VERSION} //Pascal
 function Hex2Int( const Value : KOLString) : Integer;
 var I : Integer;
 begin
@@ -20065,7 +20184,49 @@ begin
 end;
 {$ENDIF ASM_VERSION}
 
-{$IFDEF ASM_UNICODE}{$ELSE ASM_VERSION} //Pascal
+{$IFDEF ASM_UNICODE}
+function Int2Str( Value : Integer ) : KOLString;
+asm
+        XOR       ECX, ECX
+        PUSH      ECX
+        ADD       ESP, -0Ch
+
+        PUSH      EBX
+        LEA       EBX, [ESP + 15 + 4]
+        PUSH      EDX
+        CMP       EAX, ECX
+        PUSHFD
+        JGE       @@1
+        NEG       EAX
+@@1:
+        MOV       CL, 10
+
+@@2:
+        DEC       EBX
+        XOR       EDX, EDX
+        DIV       ECX
+        ADD       DL, 30h
+        MOV       [EBX], DL
+        TEST      EAX, EAX
+        JNZ       @@2
+
+        POPFD
+        JGE       @@3
+
+        DEC       EBX
+        MOV       byte ptr [EBX], '-'
+@@3:
+        POP       EAX
+        MOV       EDX, EBX
+        {$IFDEF _D2009orHigher}
+        XOR      ECX, ECX // TODO: safe to destory twice?
+        {$ENDIF}
+        CALL      System.@LStrFromPChar
+
+        POP       EBX
+        ADD       ESP, 10h
+end;
+{$ELSE ASM_VERSION} //Pascal
 function Int2Str( Value : Integer ) : KOLString;
 var Buf : Array[ 0..15 ] of KOLChar;
     Dst : PKOLChar;
@@ -25885,7 +26046,9 @@ end;
 {$ENDIF ASM_VERSION}
 
 function TThread.Execute: integer;
-//var H: THandle;
+{$IFDEF TERMAUTOFREE_THREAD}
+var H: THandle;
+{$ENDIF}
 begin
   {$IFDEF SAFE_CODE}
   Result := 0;
@@ -25896,10 +26059,14 @@ begin
   FTerminated := TRUE; // fake thread object (to prevent terminating while freeing)
   if F_AutoFree then
   begin
-//     H := FHandle;
+     {$IFDEF TERMAUTOFREE_THREAD}
-//     FHandle := 0;
+     H := FHandle;
+     {$ENDIF}
+     FHandle := 0;
      Free;
-//     TerminateThread( H, 0 );
+     {$IFDEF TERMAUTOFREE_THREAD}
+     TerminateThread( H, 0 );
+     {$ENDIF}
   end;
 end;
 
@@ -53001,17 +53168,22 @@ begin
 end;
 {$ENDIF ASM_VERSION}
 
-function _GetDIBPixelsTrueColorWithAlpha( Bmp: PBitmap; X, Y: Integer ): TColor;
+{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION}
-var
+function _GetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer ): TColor;
-  Pixel: DWORD;
+var Pixel: DWORD;
-  RGB:   TRGBQuad;
+    RGB:   TRGBQuad;
+    blue, red: Byte;
 begin
   Pixel := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta +
-                   X * Bmp.fBytesPerPixel )^ and $FFFFFFFF;
+                   X * Bmp.fBytesPerPixel )^;
   RGB := TRGBQuad(Pixel);
-  Swap(RGB.rgbBlue, RGB.rgbRed);
+  blue := RGB.rgbRed;
+  red  := RGB.rgbBlue;
+  RGB.rgbBlue := blue;
+  RGB.rgbRed  := red;
   Result := TColor( RGB );
 end;
+{$ENDIF ASM_VERSION}
 
 {$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal
 function TBitmap.GetDIBPixels(X, Y: Integer): TColor;
@@ -53135,17 +53307,22 @@ begin
 end;
 {$ENDIF ASM_VERSION}
 
-procedure _SetDIBPixelsTrueColorWithAlpha(Bmp: PBitmap; X, Y: Integer; Value: TColor);
+{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION}
+procedure _SetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer; Value: TColor );
 var RGB: TRGBQuad;
     Pos: PDWord;
+    blue, red: Byte;
 begin
   RGB := TRGBQuad(Value);
-  Swap(RGB.rgbBlue, RGB.rgbRed);
+  blue := RGB.rgbRed;
-
+  red  := RGB.rgbBlue;
+  RGB.rgbBlue := blue;
+  RGB.rgbRed  := red;
   Pos := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta
                  + X * Bmp.fBytesPerPixel );
   Pos^ := Pos^ or DWORD(RGB);
 end;
+{$ENDIF ASM_VERSION}
 
 {$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal
 procedure TBitmap.SetDIBPixels(X, Y: Integer; const Value: TColor);
@@ -59361,7 +59538,7 @@ var hDrop: THandle;
 begin
   if  Msg.message = WM_DROPFILES then
   //if  Assigned( Sender.EV.FOnDropFiles ) then
-  if  TMethod(Sender.EV.fOnDropFiles).Data <> nil then
+  if  TMethod(Sender.EV.fOnDropFiles).Code <> nil then
   begin
       hDrop := Msg.wParam;
       DragQueryPoint( hDrop, Pt );

KOL_ASM.inc

@@ -2448,127 +2448,6 @@ asm     //cmd    //opd
         POP      EBX
 end;
 
-{$IFDEF ASM_UNICODE}
-function Int2Hex( Value : DWord; Digits : Integer ) : AnsiString;
-asm     // EAX = Value
-        // EDX = Digits
-        // ECX = @Result
-
-        PUSH      0
-        ADD       ESP, -0Ch
-
-        PUSH      EDI
-        PUSH      ECX
-
-        LEA       EDI, [ESP+8+0Fh]  // EBX := @Buf[ 15 ]
-        {$IFDEF SMALLEST_CODE}
-        {$ELSE}
-        AND       EDX, $F
-        {$ENDIF}
-
-@@loop: DEC       EDI
-        DEC       EDX
-
-        PUSH      EAX
-        {$IFDEF PARANOIA} DB $24, $0F {$ELSE} AND AL, 0Fh {$ENDIF}
-
-        {$IFDEF oldcode}
-
-                {$IFDEF PARANOIA} DB $3C, 9 {$ELSE} CMP AL, 9 {$ENDIF}
-                JA        @@10
-                {$IFDEF PARANOIA} DB $04, 30h-41h+0Ah {$ELSE} ADD AL,30h-41h+0Ah {$ENDIF}
-        @@10:
-                {$IFDEF PARANOIA} DB $04, 41h-0Ah {$ELSE} ADD AL,41h-0Ah {$ENDIF}
-
-        {$ELSE newcode}
-
-                AAM
-                DB $D5, $11 //AAD
-                ADD      AL, $30
-
-        {$ENDIF newcode}
-
-
-        //MOV       byte ptr [EDI], AL
-        STOSB
-        DEC       EDI
-        POP       EAX
-        SHR       EAX, 4
-
-        JNZ       @@loop
-
-        TEST      EDX, EDX
-        JG        @@loop
-
-        POP       EAX      // EAX = @Result
-        MOV       EDX, EDI // EDX = @resulting string
-        {$IFDEF _D2009orHigher}
-        //PUSH     ECX       // TODO: remove ecx protection
-        XOR      ECX, ECX
-        {$ENDIF}
-        CALL      System.@LStrFromPChar
-        {$IFDEF _D2009orHigher}
-        //POP       ECX      // ECX popup twice to eax?
-        {$ENDIF}
-        POP       EDI
-        ADD       ESP, 10h
-
-{== by KSer - to test it only.
-function Int2Hex( Value : DWord; Digits : Integer ) : shortString;
-asm
-        MOV       [ECX], DL
-        XADD      EDX, ECX
-@@loop1:
-        PUSH      EAX
-        db   $24, $0F    // and  al,$0F
-        AAM
-        DB $D5, $11      // AAD
-        db   $04, $30    // add  al,$30
-        MOV       [EDX], AL
-        POP       EAX
-        SHR       EAX, 4
-        DEC       EDX
-        LOOP      @@loop1
-}
-end;
-
-function Hex2Int( const Value : AnsiString) : Integer;
-asm
-        CALL     EAX2PChar
-        PUSH     ESI
-        XCHG     ESI, EAX
-        XOR      EDX, EDX
-        TEST     ESI, ESI
-        JE       @@exit
-        LODSB
-        {$IFDEF PARANOIA} DB $3C, '$' {$ELSE} CMP AL, '$' {$ENDIF}
-        JNE      @@1
-@@0:    LODSB
-@@1:    TEST     AL, AL
-        JE       @@exit
-        {$IFDEF PARANOIA} DB $2C, '0' {$ELSE} SUB AL, '0' {$ENDIF}
-        {$IFDEF PARANOIA} DB $3C, 9 {$ELSE} CMP AL, '9' - '0' {$ENDIF}
-        JBE      @@3
-
-        {$IFDEF PARANOIA} DB $2C, $11 {$ELSE} SUB AL, 'A' - '0' {$ENDIF}
-        {$IFDEF PARANOIA} DB $3C, 5 {$ELSE} CMP AL, 'F' - 'A' {$ENDIF}
-        JBE      @@2
-
-        {$IFDEF PARANOIA} DB $2C, 32 {$ELSE} SUB AL, 32 {$ENDIF}
-        {$IFDEF PARANOIA} DB $3C, 5 {$ELSE} CMP AL, 'F' - 'A' {$ENDIF}
-        JA       @@exit
-@@2:
-        {$IFDEF PARANOIA} DB $04, 0Ah {$ELSE} ADD AL, 0Ah {$ENDIF}
-@@3:
-        SHL      EDX, 4
-        ADD      DL, AL
-        JMP      @@0
-
-@@exit: XCHG     EAX, EDX
-        POP      ESI
-end;
-{$ENDIF}
-
 function cHex2Int( const Value : AnsiString) : Integer;
 asm
      TEST  EAX, EAX
@@ -2585,50 +2464,6 @@ asm
 @@exit:
 end;
 
-{$IFDEF ASM_UNICODE}
-function Int2Str( Value : Integer ) : AnsiString;
-asm
-        XOR       ECX, ECX
-        PUSH      ECX
-        ADD       ESP, -0Ch
-
-        PUSH      EBX
-        LEA       EBX, [ESP + 15 + 4]
-        PUSH      EDX
-        CMP       EAX, ECX
-        PUSHFD
-        JGE       @@1
-        NEG       EAX
-@@1:
-        MOV       CL, 10
-
-@@2:
-        DEC       EBX
-        XOR       EDX, EDX
-        DIV       ECX
-        ADD       DL, 30h
-        MOV       [EBX], DL
-        TEST      EAX, EAX
-        JNZ       @@2
-
-        POPFD
-        JGE       @@3
-
-        DEC       EBX
-        MOV       byte ptr [EBX], '-'
-@@3:
-        POP       EAX
-        MOV       EDX, EBX
-        {$IFDEF _D2009orHigher}
-        XOR      ECX, ECX // TODO: safe to destory twice?
-        {$ENDIF}
-        CALL      System.@LStrFromPChar
-
-        POP       EBX
-        ADD       ESP, 10h
-end;
-{$ENDIF}
-
 function Int2Ths( I : Integer ) : AnsiString;
 asm
         PUSH     EBP
@@ -7193,7 +7028,6 @@ asm
 @@exit:
         POP       EBX
 end;
-//{$ENDIF ASM_UNICODE}
 
 function TControl.CallDefWndProc(var Msg: TMsg): Integer;
 asm
@@ -13420,6 +13254,27 @@ asm
         POP      EBX
 end;
 
+function _GetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer ): TColor;
+asm
+        PUSH     EBX
+        XCHG     EBX, EAX
+        PUSH     EDX
+        MOV      EAX, [EBX].TBitmap.fScanLineDelta
+        IMUL     ECX
+        XCHG     ECX, EAX
+        POP      EDX
+        MOV      EAX, [EBX].TBitmap.fBytesPerPixel
+        MUL      EDX
+        ADD      EAX, [EBX].TBitmap.fScanLine0
+        MOV      EAX, [EAX+ECX]
+        MOV      EDX, EAX
+        AND      EDX, $FF00FF
+        AND      EAX, $FF00FF00
+        ROL      EDX, 16
+        OR       EAX, EDX
+        POP      EBX
+end;
+
 function TBitmap.GetDIBPixels(X, Y: Integer): TColor;
 asm
         CMP      word ptr [EAX].fGetDIBPixels+2, 0
@@ -13475,7 +13330,7 @@ asm
 @@if32bit:
         LOOP     @@iffin
         INC      EDX
-        MOV      EAX, offset[_GetDIBPixelsTrueColorWithAlpha]
+        MOV      EAX, offset[_GetDIBPixelsTrueColorAlpha]
 @@iffin:
         MOV      byte ptr [EBX].fPixelMask, DH
         MOV      byte ptr [EBX].fPixelsPerByteMask, DL
@@ -13632,6 +13487,28 @@ asm
         OR       [EDX], EAX
 end;
 
+procedure _SetDIBPixelsTrueColorAlpha( Bmp: PBitmap; X, Y: Integer; Value: TColor );
+asm
+        PUSH     [EAX].TBitmap.fScanLineDelta
+        PUSH     [EAX].TBitmap.fScanLine0
+        MOV      EAX, [EAX].TBitmap.fBytesPerPixel
+        MUL      EDX
+        POP      EDX
+        ADD      EDX, EAX
+        POP      EAX
+        PUSH     EDX
+        IMUL     ECX
+        POP      EDX
+        ADD      EDX, EAX
+        MOV      EAX, Value
+        MOV      ECX, EAX
+        AND      ECX, $FF00FF
+        AND      EAX, $FF00FF00
+        ROL      ECX, 16
+        OR       EAX, ECX
+        MOV      [EDX], EAX
+end;
+
 procedure TBitmap.SetDIBPixels(X, Y: Integer; const Value: TColor);
 asm
         CMP      word ptr [EAX].fSetDIBPixels+2, 0
@@ -13679,7 +13556,7 @@ asm
 @@if32bit:
         LOOP     @@ifend
         INC      EDX
-        MOV      EAX, offset[_SetDIBPixelsTrueColorWithAlpha]
+        MOV      EAX, offset[_SetDIBPixelsTrueColorAlpha]
 @@ifend:
         MOV      byte ptr [EBX].fPixelMask, DH
         MOV      byte ptr [EBX].fPixelsPerByteMask, DL

KOLadd.pas

@@ -437,6 +437,7 @@ type
     FHandle, FinEvent: THandle;
     FPath: KOLString;
     FMonitor: PThread;
+    FDestroying: Boolean;
     function Execute( Sender: PThread ): Integer;
     procedure Changed;
   protected
@@ -2301,6 +2302,7 @@ destructor TDirChange.Destroy;
 asm
         PUSH     EBX
         XCHG     EBX, EAX
+        MOV      [EBX].FDestroying, 1
         MOV      ECX, [EBX].FMonitor
         JECXZ    @@no_monitor
         XCHG     EAX, ECX
@@ -2320,6 +2322,7 @@ end;
 {$ELSE ASM_VERSION} //Pascal
 destructor TDirChange.Destroy;
 begin
+  FDestroying := TRUE;
   if FHandle > 0 then // FHandle <> INVALID_HANDLE_VALUE AND FHandle <> 0
   begin
     OnChange := nil;
@@ -2377,15 +2380,14 @@ begin
   Handles[ 0 ] := FHandle;
   Handles[ 1 ] := FinEvent;
   while not AppletTerminated do
-    case WaitForMultipleObjects(2, @ Handles[ 0 ], FALSE, 1000) of
+    case WaitForMultipleObjects(2, @ Handles[ 0 ], FALSE, INFINITE) of
     WAIT_OBJECT_0:
       begin
-        if AppletTerminated then break;
+        if AppletTerminated or FDestroying then break;
-        Applet.GetWindowHandle;
+        //Applet.GetWindowHandle;
         Sender.Synchronize( Changed );
         FindNextChangeNotification(Handles[ 0 ]);
       end;
-    WAIT_TIMEOUT: Sleep( 100 );
     else break;
     end;
   {$IFDEF SAFE_CODE}