3.08

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

KOLDEF.inc

@@ -256,7 +256,7 @@ That is all to have full compatibility.
 
 //{$DEFINE TEST_VERSION}
 {$IFNDEF _D6orHigher}
- {$DEFINE PARANOIA} //seems not needed under D6 !!! Inprise fixed this, finally... 
+ {$DEFINE PARANOIA} //seems not needed from D6 !!! Inprise fixed this, finally...
 {$ENDIF}
 
 
@@ -264,6 +264,7 @@ That is all to have full compatibility.
          {$DEFINE USE_FLAGS}
 {$ELSE}  {$UNDEF  USE_FLAGS}
 {$ENDIF}
+
 {$IFnDEF EVENTS_STATIC}
          {$DEFINE EVENTS_DYNAMIC}
 {$ENDIF}
@@ -275,4 +276,5 @@ That is all to have full compatibility.
          {$ENDIF}
 {$ENDIF}
 
+{$DEFINE KOL3XX}
 {$DEFINE DIBPixels32bitWithAlpha}

KOLDirDlgEx.pas

@@ -111,6 +111,7 @@ type
     procedure CreateDialogForm;
     property _FindFirstFileEx: TFindFirstFileEx read GetFindFirstFileEx;
     function _FindFirstFileExW: Boolean;
+    procedure SelChanged( Sender: PObj );
     procedure DeleteNode( node: Integer );
     procedure DestroyingForm( Sender: PObj );
   public
@@ -449,9 +450,6 @@ begin
        BtnPanel.Border := 2;
        DTSubPanel.SetAlign( caClient );
        DirTree := NewTreeView( DTSubPanel, [ tvoLinesRoot ], Sysimages, nil );
-       {$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK}
-       DirTree.OnMouseDblClk := DoubleClick;
-       {$ENDIF}
        DirTree.Color := clWindow;
        DirTree.OnTVExpanding := DoExpanding;
        DirTree.SetAlign( caClient );
@@ -483,7 +481,11 @@ begin
      DirTree.SetAlign( caClient );
      MsgPanel := DlgClient;
      {$ENDIF}
+     {$IFNDEF DIRDLGEX_NO_DBLCLK_ON_NODE_OK}
+     DirTree.OnMouseDblClk := DoubleClick;
+     {$ENDIF}
      MsgPanel.OnMessage := DoMsg;
+     DirTree.OnSelChange := SelChanged;
      DlgClient := DTSubPanel; // !!!
      s := CancelCaption; if s = '' then s := 'Cancel';
      BtCancel := NewButton( BtnPanel, s );
@@ -862,6 +864,11 @@ var s, CurPath: String;
 begin
   s := IncludeTrailingPathDelimiter(
     PChar( PControl( Sender ).CustomData ) );
+  if  PControl( Sender ).RightClick then
+  begin
+      RemoveLink( s );
+  end else
+  begin
       if DirectoryExists( s ) then
       begin
         CurPath := IncludeTrailingPathDelimiter(
@@ -870,6 +877,7 @@ begin
           Form.ModalResult := 1
         else Path := s;
       end;
+  end;
 end;
 
 function TOpenDirDialogEx.LinkPresent(const s: KOLString): Boolean;
@@ -976,7 +984,8 @@ begin
     Pn.Free;
     LinksList.Delete( i );
   end;
-  Global_Align( LinksTape );
+  //LinksTape.Height := LinksTape.Height + 1;
+  //LinksTape.Height := LinksTape.Height - 1;
   SetupLinksTapeHeight;
 end;
 
@@ -1232,6 +1241,13 @@ begin
 end;
 
 {$IFDEF DIRDLGEX_LINKSPANEL}
+procedure TOpenDirDialogEx.SelChanged(Sender: PObj);
+var n: Integer;
+begin
+    n := PControl(Sender).TVSelected;
+    RescanNode( n );
+end;
+
 procedure TOpenDirDialogEx.SetLinks(idx: Integer; const Value: KOLString);
 var Bar, Pn: PControl;
     Bmp: PBitmap;
@@ -1278,7 +1294,7 @@ begin
   {$ENDIF USE_GRUSH}
   {$ENDIF DIRDLGEX_BIGGERPANEL}
   NewPanelWithSingleButtonToolbar( LinksTape, LinksBox.Width-8,
-    H, caTop, Bmp,
+    H, caNone, Bmp,
     ExtractFileName( s ), s, Pn, Bar, LinkClick, nil, nil, LinksBtnDnEvt, LinksPopupMenu );
   Pn.CreateWindow;
 
@@ -1317,13 +1333,18 @@ end;
 procedure TOpenDirDialogEx.SetupLinksTapeHeight;
 var H: Integer;
     Pn: PControl;
+    i: Integer;
 begin
   H := 0;
   if (LinksList <> nil) and (LinksList.Count > 0) then
   begin
-    Pn := Pointer( LinksList.Objects[ LinksList.Count-1 ] );
+    for i := 0 to LinksList.Count-1 do
+    begin
+        Pn := Pointer( LinksList.Objects[ i ] );
+        Pn.Top := H;
         H := Pn.Top + Pn.Height;
     end;
+  end;
   LinksTape.Height := H + 4;
 end;
 

KOL_ASM.inc

@@ -1,6 +1,6 @@
 //------------------------------------------------------------------------------
 // KOL_ASM.inc ()to be inlude in KOL.pas)
-// v 3.05
+// v 3.08
 
 function MsgBox( const S: KOLString; Flags: DWORD ): DWORD;
 asm
@@ -1675,16 +1675,17 @@ end;
 procedure TCanvas.SetHandle(Value: HDC);
 asm
         PUSH     EBX
-        MOV      EBX, EAX
+        PUSH     ESI
-        MOV      ECX, [EBX].fHandle
+        MOV      ESI, EDX             // ESI = Value
-        CMP      ECX, EDX
+        MOV      EBX, EAX             // EAX = @ Self
-        JZ       @@exit
+        MOV      ECX, [EBX].fHandle   // ECX = fHandle (before)
-        JECXZ    @@chk_val
+        CMP      ECX, ESI             // compare with new Value in EDX
+        JZ       @@exit               // equal? -> nothing to do
+        JECXZ    @@chk_val            // fHandle = 0? -> check new value in EDX
 
-        PUSH     EDX
+        PUSH     ECX  // fHandle
-        PUSH     ECX
           CALL     DeselectHandles
-        POP      EDX
+        POP      EDX  // fHandle
 
         MOV      ECX, [EBX].fOwnerControl
         JECXZ    @@chk_Release
@@ -1692,13 +1693,16 @@ asm
         JE       @@clr_Handle
 
 @@chk_Release:
-        PUSH     EDX
         CMP      [EBX].fOnGetHandle.TMethod.Code, offset[TControl.DC2Canvas]
         JNE      @@deldc
+        PUSH     EDX  // fHandle
         PUSH     [ECX].TControl.fHandle
         CALL     ReleaseDC
         JMP      @@clr_Handle
 @@deldc:
+        CMP      WORD PTR [EBX].fIsPaintDC, 0
+        JNZ      @@clr_Handle
+        PUSH     EDX  // fHandle
         CALL     DeleteDC
 
 @@clr_Handle:
@@ -1707,18 +1711,18 @@ asm
         MOV      [EBX].TCanvas.fIsPaintDC, CL
         AND      [EBX].TCanvas.fState, not HandleValid
 
-        POP      EDX
 @@chk_val:
-        TEST     EDX, EDX
+        TEST     ESI, ESI
         JZ       @@exit
 
         OR       [EBX].TCanvas.fState, HandleValid
-        MOV      [EBX].TCanvas.fHandle, EDX
+        MOV      [EBX].TCanvas.fHandle, ESI
         LEA      EDX, [EBX].TCanvas.fPenPos
         MOV      EAX, EBX
         CALL     SetPenPos
 
-@@exit: POP      EBX
+@@exit: POP      ESI
+        POP      EBX
 end;
 
 procedure TCanvas.SetPenPos(const Value: TPoint);
@@ -2854,6 +2858,10 @@ end;
 
 function TDirList.GetCount: Integer;
 asm
+        {CMP      EAX, 0
+        JNZ      @@1
+        NOP
+@@1:    }
         MOV      ECX, [EAX].FListPositions
         JECXZ    @@retECX
         MOV      ECX, [ECX].TList.fCount
@@ -5419,7 +5427,7 @@ asm     //cmd    //opd
 @@callonmes:
         {$IFDEF  NIL_EVENTS}
         TEST     EBX, EBX
-        JZ       @@exit // @@dynmes1
+        JZ       @@ret 
         {$ENDIF}
 @@onmess1:
         PUSH     0
@@ -5914,7 +5922,8 @@ end;
 
 function TControl.GetVisible: Boolean;
 asm
-        MOV     ECX, [EAX].fHandle
+        //CALL    UpdateWndStyles
+        {MOV     ECX, [EAX].fHandle
         JECXZ   @@check_fStyle
           PUSH  EAX
         PUSH    ECX
@@ -5922,9 +5931,9 @@ asm
         TEST    EAX, EAX
           POP   EAX
         JMP     @@checked // Z if not visible
-
+        }
 @@check_fStyle:
-        TEST    byte ptr [EAX].fStyle.f3_Style, F3_Visible // WS_VISIBLE shr 3
+        TEST    byte ptr [EAX].fStyle.f3_Style, 1 shl F3_Visible // WS_VISIBLE shr 3
 @@checked:
         {$IFDEF USE_FLAGS}
         SETNZ   AL
@@ -6548,6 +6557,7 @@ asm
         MOV       ESI, EAX
 
         CALL      GetEnabled
+        (*
         {$IFDEF   USE_FLAGS}
         MOV       DL, byte ptr [ESI].TControl.fStyle.f2_Style
         // F2_Tabstop = 0 !
@@ -6556,6 +6566,8 @@ asm
         OR        DL, [ESI].TControl.fTabstop
         {$ENDIF   USE_FLAGS}
         AND       AL, DL
+        *)
+        TEST      AL, AL
         JZ        @@exit
 
         INC       [ESI].TControl.fClickDisabled
@@ -9392,6 +9404,8 @@ asm
         {$ENDIF}
 @@01:
         MOV      EAX, [EAX].fList
+        TEST     EAX, EAX
+        JZ       @@exit
         MOV      EDX, [EAX].TList.fCount
         CMP      EDX, 1
         JLE      @@02
@@ -9407,6 +9421,7 @@ asm
 @1:     MOV      EDX, [EAX].fCount
         CALL     SortData
         {$ENDIF}
+@@exit:
 end;
 
 procedure TStrList.MergeFromFile(const FileName: KOLString);
@@ -11370,10 +11385,12 @@ asm
         LOOP     @@ret_Canvas
 
         MOV      [EBX].fApplyBkColor2Canvas, offset[ApplyBitmapBkColor2Canvas]
-        PUSH     0
+        //CALL     CreateCompatibleDC
-        CALL     CreateCompatibleDC
+        XOR      EAX, EAX
+        //PUSH     EAX
         CALL     NewCanvas
         MOV      [EBX].fCanvas, EAX
+        //MOV      [EAX].TCanvas.fIsAlienDC, 0
         MOV      [EAX].TCanvas.fOnChangeCanvas.TMethod.Code, offset[CanvasChanged]
         MOV      [EAX].TCanvas.fOnChangeCanvas.TMethod.Data, EBX
         CALL     TCanvas.GetBrush
@@ -13912,6 +13929,15 @@ asm
     MOV  [EAX].TControl.fWordWrap, 1
     {$ENDIF}
     AND  byte ptr[EAX].TControl.fStyle.f0_Style, not SS_LEFTNOWORDWRAP
+
+    {$IFDEF USE_FLAGS}
+    TEST [EAX].TControl.fFlagsG5, 1 shl G5_IsButton
+    {$ELSE}
+    CMP  [EAX].TControl.fIsButton, 0
+    {$ENDIF}
+    JZ   @@1
+    OR   [EAX].TControl.fStyle.f1_Style, $20 // BS_MULTILINE >> 8
+@@1:
     PUSH EAX
     MOV  EDX, [EAX].TControl.fStyle
     CALL TControl.SetStyle

KOLadd.pas

@@ -15,7 +15,7 @@
 
 //[VERSION]
 ****************************************************************
-* VERSION 3.05
+* VERSION 3.05+
 ****************************************************************
 //[END OF VERSION]
 
@@ -433,11 +433,16 @@ type
   TDirChange = object(TObj)
   {* Object type to monitor changes in certain folder. }
   protected
+    {$IFDEF DIRCHG_ONEXECUTE}
+    FOnExecute: TOnEvent;
+    {$ENDIF}
     FOnChange: TOnDirChange;
     FHandle, FinEvent: THandle;
     FPath: KOLString;
     FMonitor: PThread;
+    FWatchSubtree: Boolean;
     FDestroying: Boolean;
+    FFlags: DWORD;
     function Execute( Sender: PThread ): Integer;
     procedure Changed;
   protected
@@ -450,10 +455,15 @@ type
     {* Path to monitored folder (to a root, if tree of folders
        is under monitoring). }
     property OnChange: TOnDirChange read FOnChange write FOnChange;
+    {$IFDEF DIRCHG_ONEXECUTE}
+    property OnExecute: TOnEvent read FOnExecute write FOnExecute;
+    {$ENDIF}
   end;
 
 function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter;
-                               WatchSubtree: Boolean; ChangeProc: TOnDirChange )
+                               WatchSubtree: Boolean; ChangeProc: TOnDirChange
+                               {$IFDEF DIRCHG_ONEXECUTE} ; OnExecuteProc: TOnEvent
+                               {$ENDIF} )
                                : PDirChange;
 {* Creates notification object TDirChange. If something wrong (e.g.,
    passed directory does not exist), nil is returned as a result. When change
@@ -1006,7 +1016,7 @@ begin
   if FromIdx + N > FromBits.Count then
     N := FromBits.Count - FromIdx;
   Capacity := (ToIdx + N + 8) div 8;
-  NewCount := Max( Count, ToIdx + N - 1 );
+  NewCount := Max( Count, ToIdx + N );
   fCount := Max( NewCount, fCount );
   PBitsList( fList ).fCount := (Capacity + 3) div 4;
   while ToIdx and $1F <> 0 do
@@ -1186,6 +1196,8 @@ begin
           MOV  D, EAX
         end {$IFDEF F_P} [ 'EAX' ] {$ENDIF};
         Result := I * 32 + Integer( D );
+        if  Result >= fCount then
+            Result := -1;
         break;
       end;
     end;
@@ -1271,7 +1283,7 @@ begin
 end;
 
 //[procedure TBits.SetBit]
-{$IFDEF ASM_VERSION}
+{$IFDEF ASM_noVERSION}
 procedure TBits.SetBit(Idx: Integer; const Value: Boolean);
 asm
   PUSH EBX
@@ -1296,6 +1308,7 @@ asm
   PUSH EDX
   INC  EDX
   PUSH EAX
+  MOV  EAX, EBX
   CALL SetCapacity
   POP  EAX
   POP  EDX
@@ -1319,12 +1332,14 @@ procedure TBits.SetBit(Idx: Integer; const Value: Boolean);
 var Msk: DWORD;
     MinListCount: Integer;
 begin
-  MinListCount := (Idx + 31) shr 5 + 1;
+  MinListCount := //(Idx + 31) shr 5 + 1;
+                  (Idx + 32) shr 5;
   if  PBitsList( fList ).fCount < MinListCount then
   begin
       PBitsList( fList ).fCount := MinListCount;
       if  Idx >= Capacity then
-          Capacity := Idx + 1;
+          Capacity := //Idx + 1;
+                      MinListCount shl 5;
   end;
   Msk := 1 shl (Idx and $1F);
   if  Value then
@@ -2260,30 +2275,26 @@ asm
 end;
 {$ELSE ASM_VERSION} //Pascal
 function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter;
-                               WatchSubtree: Boolean; ChangeProc: TOnDirChange )
+                               WatchSubtree: Boolean; ChangeProc: TOnDirChange
+                               {$IFDEF DIRCHG_ONEXECUTE}; OnExecuteProc: TOnEvent
+                               {$ENDIF} )
                                : PDirChange;
-var Flags: DWORD;
 begin
   New( Result, Create );
+  {$IFDEF DIRCHG_ONEXECUTE}
+  Result.OnExecute := OnExecuteProc;
+  {$ENDIF}
 
   Result.FPath := Path;
+  Result.FWatchSubtree := WatchSubtree;
   Result.FOnChange := ChangeProc;
   if  Filter = [ ] then
-    Flags := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
+      Result.FFlags := FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME or
       FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or
       FILE_NOTIFY_CHANGE_LAST_WRITE
   else
-      Flags := MakeFlags( @Filter, FilterFlags );
+      Result.FFlags := MakeFlags( @Filter, FilterFlags );
-  Result.FinEvent := CreateEvent( nil, TRUE, FALSE, nil );
-  Result.FHandle := FindFirstChangeNotification(PKOLChar(Result.FPath),
-                    Bool( Integer( WatchSubtree ) ), Flags);
-  if  Result.FHandle <> INVALID_HANDLE_VALUE then
   Result.FMonitor := NewThreadEx( Result.Execute )
-  else //MsgOK( 'Can not monitor ' + Result.FPath + #13'Error ' + Int2Str( GetLastError ) );
-  begin
-      Result.Free;
-      Result := nil;
-  end;
 end;
 {$ENDIF ASM_VERSION}
 //[END _NewDirChgNotifier]
@@ -2342,12 +2353,15 @@ begin
     OnChange := nil;
     SetEvent( FinEvent );
   end;
-  if  FMonitor <> nil then
+  while FinEvent <> 0 do
   begin
-      FMonitor.WaitFor;
+      if  Applet <> nil then
-      FMonitor.Free;
+          Applet.ProcessMessages; // otherwise deadlock is possible !!!
+      Sleep( 1 );                 // otherwise processor load can be too high !!!
+      if  AppletTerminated then
+          break;
   end;
-  CloseHandle( FinEvent );
+  FMonitor.Free;
   FPath := '';
   inherited;
 end;
@@ -2394,6 +2408,13 @@ function TDirChange.Execute(Sender: PThread): Integer;
 var Handles: array[ 0..1 ] of THandle;
     //i: Integer;
 begin
+  {$IFDEF DIRCHG_ONEXECUTE}
+  if  Assigned( OnExecute ) then
+      OnExecute( @ Self );
+  {$ENDIF}
+  FinEvent := CreateEvent( nil, TRUE, FALSE, nil );
+  FHandle := FindFirstChangeNotification(PKOLChar(FPath),
+          Bool( Integer( FWatchSubtree ) ), FFlags);
   Handles[ 0 ] := FHandle;
   Handles[ 1 ] := FinEvent;
   while not AppletTerminated do
@@ -2401,7 +2422,6 @@ begin
     WAIT_OBJECT_0:
       begin
         if AppletTerminated or FDestroying then break;
-        //Applet.GetWindowHandle;
         Sender.Synchronize( Changed );
         FindNextChangeNotification(Handles[ 0 ]);
       end;
@@ -2411,7 +2431,9 @@ begin
   TRY
   {$ENDIF}
   FindCloseChangeNotification( Handles[ 0 ] );
-  //CloseHandle( Handles[ 1 ] );
+  FHandle := 0;
+  CloseHandle( FinEvent );
+  FinEvent := 0;
   {$IFDEF SAFE_CODE}
   EXCEPT
   END;
@@ -3506,8 +3528,8 @@ begin
     end;
     W := Btn.BoundsRect.Right;
   end;
-  DlgPrnt.Width := Max(
+  DlgPrnt.ClientWidth := Max(
-    Max( DlgPrnt.Width, Lab.Left + Lab.Width + 4 ), W + 8 );
+    Max( DlgPrnt.ClientWidth, Lab.Left + Lab.Width + 4 ), W + 8 );
   X := (DlgPrnt.ClientWidth - W) div 2;
   for I := 0 to Buttons.Count-1 do
   begin
@@ -3536,7 +3558,7 @@ begin
   {$ENDIF TOGRUSH_OPTIONAL}
   begin
     DlgPrnt.ResizeParent;
-    DlgPrnt.Width := Max( DlgPrnt.Width, Dialog.Width - 14 );
+    DlgPrnt.ClientWidth := Max( DlgPrnt.ClientWidth, Dialog.Width - 14 );
   end;
   Bmp.Free;
   {$ENDIF USE_GRUSH}
@@ -3561,8 +3583,7 @@ begin
     Dialog.ShowModal;
     Result := Dialog.ModalResult;
     Dialog.Free;
-  end
+  end else
-    else
   begin
     DlgWnd := Dialog.Handle;
     while IsWindow( DlgWnd ) and (Dialog.ModalResult = 0) do

mirror.pas

@@ -8228,6 +8228,8 @@ begin
       if  (KF <> nil) and KF.FormCompact then
       begin
           KF.FormAddCtlCommand( Name, 'TControl.SetDefaultBtn' );
+          KF.FormAddNumParameter( 13 );
+          KF.FormAddNumParameter( 1 );
           // param = 1
       end else
       SL.Add( Prefix + AName + '.DefaultBtn := TRUE;' );
@@ -8235,7 +8237,9 @@ begin
   if  fCancelBtn then
       if  (KF <> nil) and KF.FormCompact then
       begin
-          KF.FormAddCtlCommand( Name, 'TControl.SetCancelBtn' );
+          KF.FormAddCtlCommand( Name, 'TControl.SetDefaultBtn' );
+          KF.FormAddNumParameter( 27 );
+          KF.FormAddNumParameter( 1 );
           // param = 1
       end else
       SL.Add( Prefix + AName + '.CancelBtn := TRUE;' );
@@ -8247,11 +8251,13 @@ begin
               Integer( AnchorTop ) shl 1 +
               Integer( AnchorRight ) shl 2 +
               Integer( AnchorBottom ) shl 3;
+          if  (i = 1) or (i = 2) or (i = 4) or (i = 8) then
+              KF.FormAddCtlCommand( Name, 'TControl.SetAnchor' );
           CASE i OF
-          1:  KF.FormAddCtlCommand( Name, 'TControl.SetAnchorLeft' );
+          1:  KF.FormAddNumParameter( ANCHOR_LEFT );
-          2:  KF.FormAddCtlCommand( Name, 'TControl.SetAnchorTop' );
+          2:  KF.FormAddNumParameter( ANCHOR_TOP );
-          4:  KF.FormAddCtlCommand( Name, 'TControl.SetAnchorRight' );
+          4:  KF.FormAddNumParameter( ANCHOR_RIGHT );
-          8:  KF.FormAddCtlCommand( Name, 'TControl.SetAnchorBottom' );
+          8:  KF.FormAddNumParameter( ANCHOR_BOTTOM );
           else
               KF.FormAddCtlCommand( Name, 'FormSetAnchor' );
               KF.FormAddNumParameter( i );