Fixed crash when using ole functions

Fixed drawing when using drag and drop

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@115 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/virtualtreeview-unstable/VirtualTrees.pas

@@ -12535,7 +12535,7 @@ begin
           if (poDrawSelection in PaintOptions) and (toFullRowSelect in FOptions.FSelectionOptions) and
             (vsSelected in Node.States) and not (toUseBlendedSelection in FOptions.PaintOptions) then
           begin
-            Logger.Send([lcPaintDetails],'Setting the color of a selected node');
+            Logger.Send([lcPaintDetails,lcDrag],'Setting the color of a selected node');
             if toShowHorzGridLines in FOptions.PaintOptions then
               Dec(R.Bottom);
             if Focused or (toPopupMode in FOptions.FPaintOptions) then
@@ -13779,7 +13779,8 @@ begin
           end
           else
           begin
-            Brush.Style := bsClear;
+            //todo: remove comment when LCL is fixed
+            //Brush.Style := bsClear;
           end;
         end
         else
@@ -15091,6 +15092,7 @@ var
   Formats: TFormatArray;
 
 begin
+  Logger.EnterMethod([lcDrag],'CMDrag');
   with Message, DragRec^ do
   begin
     S := Source;
@@ -15172,6 +15174,7 @@ begin
       end;
     end;
   end;
+  Logger.ExitMethod([lcDrag],'CMDrag');
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -17950,9 +17953,8 @@ begin
   PrepareBitmaps(True, True);
 
   // Register tree as OLE drop target.
-  // Somehow calling this code causes a SIGSEG
+  if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then
-  //if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then
+     RegisterDragDrop(Handle, DragManager as IDropTarget);
-  //  RegisterDragDrop(Handle, DragManager as IDropTarget);
 
   UpdateScrollBars(True);
   UpdateHeaderRect;
@@ -18762,6 +18764,7 @@ var
   DataObject: IDataObject;
 
 begin
+  Logger.EnterMethod([lcDrag],'DoDragging');
   DataObject := nil;
   // Dragging is dragging, nothing else.
   DoCancelEdit;
@@ -18800,7 +18803,7 @@ begin
     DragEffect := DROPEFFECT_NONE;
     AllowedEffects := GetDragOperations;
     try
-      ActiveX.DoDragDrop(DataObject, DragManager as IDropSource, AllowedEffects, @DragEffect);
+      VirtualTrees.DoDragDrop(DataObject, DragManager as IDropSource, AllowedEffects, @DragEffect);
       DragManager.ForceDragLeave;
     finally
       GetCursorPos(P);
@@ -18829,6 +18832,7 @@ begin
   finally
     FDragSelection := nil;
   end;
+  Logger.ExitMethod([lcDrag],'DoDragging');
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -19428,14 +19432,17 @@ var
   SavePenStyle: TPenStyle;
 
 begin
+  Logger.EnterMethod([lcDrag],'DoPaintDropMark');
   if FLastDropMode in [dmAbove, dmBelow] then
     with Canvas do
     begin
+      Logger.Send([lcDrag],'DropMode in [dmAbove,dmBelow]');
       SavePenStyle := Pen.Style;
       Pen.Style := psClear;
       SaveBrushColor := Brush.Color;
       Brush.Color := FColors.DropMarkColor;
-
+      Logger.SendColor([lcDrag],'Brush.Color',Brush.Color);
+      Logger.Send([lcDrag],'R',R);
       if FLastDropMode = dmAbove then
       begin
         Polygon([Point(R.Left + 2, R.Top),
@@ -19457,6 +19464,7 @@ begin
       Brush.Color := SaveBrushColor;
       Pen.Style := SavePenStyle;
     end;
+  Logger.ExitMethod([lcDrag],'DoPaintDropMark');
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -19694,12 +19702,14 @@ end;
 procedure TBaseVirtualTree.DoStartDrag(var DragObject: TDragObject);
 
 begin
+  Logger.EnterMethod([lcDrag],'DoStartDrag');
   inherited;
 
   // Check if the application created an own drag object. This is needed to pass the correct source in
   // OnDragOver and OnDragDrop.
   if Assigned(DragObject) then
     DoStateChange([tsUserDragObject]);
+  Logger.ExitMethod([lcDrag],'DoStartDrag');
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -20000,6 +20010,7 @@ var
   Formats: TFormatArray;
 
 begin
+  Logger.EnterMethod([lcDrag],'DragDrop');
   StopTimer(ExpandTimer);
   StopTimer(ScrollTimer);
   DoStateChange([], [tsScrollPending, tsScrolling]);
@@ -20049,6 +20060,7 @@ begin
       FDropTargetNode := nil;
     end;
   end;
+  Logger.ExitMethod([lcDrag],'DragDrop');
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -20064,6 +20076,7 @@ var
   HitInfo: THitInfo;
 
 begin
+  Logger.EnterMethod([lcDrag],'DragEnter');
   try
     // Determine acceptance of drag operation and reset scroll start time.
     FDragScrollStart := 0;
@@ -20109,6 +20122,7 @@ begin
   except
     Result := E_UNEXPECTED;
   end;
+  Logger.ExitMethod([lcDrag],'DragEnter');
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -20122,6 +20136,7 @@ var
   P: TPoint;
 
 begin
+  Logger.EnterMethod([lcDrag],'DragFinished');
   DoStateChange([], [tsVCLDragPending, tsVCLDragging, tsUserDragObject]);
 
   GetCursorPos(P);
@@ -20133,6 +20148,7 @@ begin
       Perform(LM_MBUTTONUP, 0, Longint(PointToSmallPoint(P)))
     else
       Perform(LM_LBUTTONUP, 0, Longint(PointToSmallPoint(P)));
+  Logger.ExitMethod([lcDrag],'DragFinished');
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -20185,6 +20201,7 @@ var
   ScrollOptions: TScrollUpdateOptions;
 
 begin
+  //Logger.EnterMethod([lcDrag],'DragOver');
   if not DragManager.DropTargetHelperSupported and (Source is TBaseVirtualTree) then
   begin
     Tree := Source as TBaseVirtualTree;
@@ -20199,7 +20216,7 @@ begin
   try
     DragPos := Pt;
     Pt := ScreenToClient(Pt);
-
+    //Logger.Send([lcDrag],'Pt',Pt);
     // Check if we have to scroll the client area.
     FScrollDirections := DetermineScrollDirections(Pt.X, Pt.Y);
     DeltaX := 0;
@@ -20375,6 +20392,7 @@ begin
   except
     Result := E_UNEXPECTED;
   end;
+  //Logger.ExitMethod([lcDrag],'DragOver');
 end;
 
 //----------------------------------------------------------------------------------------------------------------------
@@ -22385,10 +22403,11 @@ begin
       // The clipping rectangle is given in client coordinates of the window. We have to convert it into
       // a sliding window of the tree image.
       Logger.Send([lcPaintDetails],'FEffectiveOffsetX: %d, RTLOffset: %d, OffsetY: %d',[FEffectiveOffsetX,RTLOffset,FOffsetY]);
-      //Logger.Send([lcPaint],'Window Before Offset',Window);
+
       Windows.OffsetRect(Window, FEffectiveOffsetX - RTLOffset, -FOffsetY);
-      //Logger.Send([lcPaint],'Window After Offset',Window);
+      Logger.Active:=Logger.CalledBy('DoDragging');
       PaintTree(Canvas, Window, Target, Options);
+      Logger.Active:=True;
     end
     else
     begin
@@ -27592,9 +27611,7 @@ begin
         // It is usually smaller than an entire node and wanders while the paint loop advances.
         MaximumRight := Target.X + (Window.Right - Window.Left);
         MaximumBottom := Target.Y + (Window.Bottom - Window.Top);
-        //lclheader
+
-        //if hoVisible in FHeader.FOptions then
-        //  Dec(MaximumBottom,FHeader.Height);
         Logger.Send([lcPaintHeader],'MaximumRight: %d MaximumBottom: %d',[MaximumRight,MaximumBottom]);
         TargetRect := Rect(Target.X, Target.Y - (Window.Top - BaseOffset), MaximumRight, 0);
         TargetRect.Bottom := TargetRect.Top;
@@ -27643,6 +27660,7 @@ begin
               begin
                 if Height <> PaintInfo.Node.NodeHeight then
                 begin
+                  Logger.Send([lcPaintDetails],'Setting the Node Height');
                   // Avoid that the VCL copies the bitmap while changing its height.
                   Height := 0;
                   Height := PaintInfo.Node.NodeHeight;
@@ -27897,10 +27915,13 @@ begin
             end;
 
             Inc(TargetRect.Top, PaintInfo.Node.NodeHeight);
-            Logger.SendIf([lcPaintHeader],'Last Node to be painted: '+ IntToStr(PaintInfo.Node^.Index)
+            Logger.SendIf([lcPaintHeader,lcDrag],'Last Node to be painted: '+ IntToStr(PaintInfo.Node^.Index)
               +' (TargetRect.Top >= MaximumBottom)',TargetRect.Top >= MaximumBottom);
             if TargetRect.Top >= MaximumBottom then
+            begin
+              Logger.ExitMethod([lcPaintDetails],'PaintNode');
               Break;
+            end;
 
             // Keep selection rectangle coordinates in sync.
             if DrawSelectionRect then

components/virtualtreeview-unstable/demos/ole/Main.lfm

@@ -1,7 +1,7 @@
 object MainForm: TMainForm
-  Left = 347
+  Left = 117
   Height = 575
-  Top = 303
+  Top = 135
   Width = 790
   HorzScrollBar.Page = 789
   VertScrollBar.Page = 574

components/virtualtreeview-unstable/demos/ole/Main.lrs

@@ -1,18 +1,18 @@
 { This is an automatically generated lazarus resource file }
 
 LazarusResources.Add('TMainForm','FORMDATA',[
-  'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#3'['#1#6'Height'#3'?'#2#3'Top'#3'/'#1
+  'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#2'u'#6'Height'#3'?'#2#3'Top'#3#135#0#5
-  +#5'Width'#3#22#3#18'HorzScrollBar.Page'#3#21#3#18'VertScrollBar.Page'#3'>'#2
+  +'Width'#3#22#3#18'HorzScrollBar.Page'#3#21#3#18'VertScrollBar.Page'#3'>'#2#13
-  +#13'ActiveControl'#7#7'Button1'#7'Caption'#6',Demo for drag''n drop and clip'
+  +'ActiveControl'#7#7'Button1'#7'Caption'#6',Demo for drag''n drop and clipboa'
-  +'board transfers'#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#244#9
+  +'rd transfers'#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#244#9'F'
-  +'Font.Name'#6#5'Arial'#8'OnCreate'#7#10'FormCreate'#7'Visible'#9#0#6'TLabel'
+  +'ont.Name'#6#5'Arial'#8'OnCreate'#7#10'FormCreate'#7'Visible'#9#0#6'TLabel'#6
-  +#6'Label1'#4'Left'#2#10#6'Height'#2#15#3'Top'#2'`'#5'Width'#3#239#0#7'Captio'
+  +'Label1'#4'Left'#2#10#6'Height'#2#15#3'Top'#2'`'#5'Width'#3#239#0#7'Caption'
-  +'n'#6'1Tree 1 uses OLE when initiating a drag operation.'#5'Color'#7#6'clNon'
+  +#6'1Tree 1 uses OLE when initiating a drag operation.'#5'Color'#7#6'clNone'
-  +'e'#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#245#9'Font.Name'#6
+  +#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#245#9'Font.Name'#6#5
-  +#5'Arial'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3'h'#1#6'Height'
+  +'Arial'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3'h'#1#6'Height'#2
-  +#2'!'#3'Top'#2'P'#5'Width'#3'Q'#1#8'AutoSize'#8#7'Caption'#6#137'Tree 2 uses'
+  +'!'#3'Top'#2'P'#5'Width'#3'Q'#1#8'AutoSize'#8#7'Caption'#6#137'Tree 2 uses V'
-  +' VCL when initiating a drag operation. It also uses manual drag mode. Only '
+  +'CL when initiating a drag operation. It also uses manual drag mode. Only ma'
-  +'marked lines are allowed to start a drag operation.'#5'Color'#7#6'clNone'#12
+  +'rked lines are allowed to start a drag operation.'#5'Color'#7#6'clNone'#12
   +'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#245#9'Font.Name'#6#5'Ari'
   +'al'#11'ParentColor'#8#8'WordWrap'#9#0#0#6'TPanel'#6'Panel3'#6'Height'#2'E'#5
   +'Width'#3#22#3#5'Align'#7#5'alTop'#5'Color'#7#7'clWhite'#11'ParentColor'#8#8

components/virtualtreeview-unstable/demos/ole/Main.pas

@@ -11,7 +11,7 @@ interface
 uses 
   Windows, LCLIntf, Messages, ActiveX, SysUtils, Forms, Dialogs, Graphics,
   VirtualTrees, ActnList, ComCtrls, ExtCtrls, StdCtrls, Controls, Classes, Buttons,
-  ImgList, LResources;
+  ImgList, LResources, vtLogger,ipcchannel;
 
 type
   TMainForm = class(TForm)
@@ -89,6 +89,8 @@ type
     Caption: WideString;
   end;
 
+procedure ReleaseStgMedium(_para1:LPSTGMEDIUM);stdcall;external 'ole32.dll' name 'ReleaseStgMedium';
+
 //----------------------------------------------------------------------------------------------------------------------
 
 procedure TMainForm.Button1Click(Sender: TObject);
@@ -204,8 +206,12 @@ var
   Stream: TResourceStream;
 
 begin
+  Logger.Channels.Add(TIPCChannel.Create);
+  Logger.Clear;
+  Logger.ActiveClasses:=[lcDrag,lcPaintDetails,lcPaintBitmap];
+  //Logger.Enabled:=False;
   Tree1.NodeDataSize := SizeOf(TNodeData);
-  Tree1.RootNodeCount := 30;
+  Tree1.RootNodeCount := 10;
   Tree2.NodeDataSize := SizeOf(TNodeData);
   Tree2.RootNodeCount := 30;
 

components/virtualtreeview-unstable/demos/ole/ole.lpi

@@ -17,7 +17,6 @@
     </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
       <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
       <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
     </PublishOptions>

components/virtualtreeview-unstable/lclfunctions.inc

@@ -253,3 +253,17 @@ begin
 end;
 
 {$endif}
+
+function RegisterDragDrop(hwnd:HWND; pDropTarget:IDropTarget):WINOLEAPI;stdcall;external 'ole32.dll' name 'RegisterDragDrop';
+
+function RevokeDragDrop(hwnd:HWND):WINOLEAPI;stdcall;external 'ole32.dll' name 'RevokeDragDrop';
+
+function DoDragDrop(pDataObj:IDataObject; pDropSource:IDropSource; dwOKEffects:DWORD; pdwEffect:LPDWORD):WINOLEAPI;stdcall;external 'ole32.dll' name 'DoDragDrop';
+
+function OleInitialize(pvReserved:LPVOID):WINOLEAPI;stdcall;external 'ole32.dll' name 'OleInitialize';
+
+procedure OleUninitialize;stdcall;external 'ole32.dll' name 'OleUninitialize';
+
+procedure ReleaseStgMedium(_para1:LPSTGMEDIUM);stdcall;external 'ole32.dll' name 'ReleaseStgMedium';
+
+

components/virtualtreeview-unstable/vtlogger.pas

@@ -31,6 +31,7 @@ const
   lcEraseBkgnd = 16;
   lcColumnPosition = 17;
   lcTimer = 18;
+  lcDrag = 19;
 var
   Logger: TLCLLogger;