pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Fixed crash when using ole functions

Browse Source 
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
This commit is contained in:
blikblum
2007-03-05 01:29:44 +00:00
parent 099366f18b
commit 7a193d82da
7 changed files with 72 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
components/virtualtreeview-unstable/VirtualTrees.pas
View File

@ -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
// RegisterDragDrop(Handle, DragManager as IDropTarget);
if not (csDesigning in ComponentState) and (toAcceptOLEDrop in FOptions.FMiscOptions) then
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

4
components/virtualtreeview-unstable/demos/ole/Main.lfm
View File

@ -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

24
components/virtualtreeview-unstable/demos/ole/Main.lrs
View File

@ -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
+#5'Width'#3#22#3#18'HorzScrollBar.Page'#3#21#3#18'VertScrollBar.Page'#3'>'#2
+#13'ActiveControl'#7#7'Button1'#7'Caption'#6',Demo for drag''n drop and clip'
+'board transfers'#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#244#9
+'Font.Name'#6#5'Arial'#8'OnCreate'#7#10'FormCreate'#7'Visible'#9#0#6'TLabel'
+#6'Label1'#4'Left'#2#10#6'Height'#2#15#3'Top'#2'`'#5'Width'#3#239#0#7'Captio'
+'n'#6'1Tree 1 uses OLE when initiating a drag operation.'#5'Color'#7#6'clNon'
+'e'#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#245#9'Font.Name'#6
+#5'Arial'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3'h'#1#6'Height'
+#2'!'#3'Top'#2'P'#5'Width'#3'Q'#1#8'AutoSize'#8#7'Caption'#6#137'Tree 2 uses'
+' VCL when initiating a drag operation. It also uses manual drag mode. Only '
+'marked lines are allowed to start a drag operation.'#5'Color'#7#6'clNone'#12
'TPF0'#9'TMainForm'#8'MainForm'#4'Left'#2'u'#6'Height'#3'?'#2#3'Top'#3#135#0#5
+'Width'#3#22#3#18'HorzScrollBar.Page'#3#21#3#18'VertScrollBar.Page'#3'>'#2#13
+'ActiveControl'#7#7'Button1'#7'Caption'#6',Demo for drag''n drop and clipboa'
+'rd transfers'#12'Font.CharSet'#7#12'ANSI_CHARSET'#11'Font.Height'#2#244#9'F'
+'ont.Name'#6#5'Arial'#8'OnCreate'#7#10'FormCreate'#7'Visible'#9#0#6'TLabel'#6
+'Label1'#4'Left'#2#10#6'Height'#2#15#3'Top'#2'`'#5'Width'#3#239#0#7'Caption'
+#6'1Tree 1 uses OLE when initiating 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
+'Arial'#11'ParentColor'#8#0#0#6'TLabel'#6'Label2'#4'Left'#3'h'#1#6'Height'#2
+'!'#3'Top'#2'P'#5'Width'#3'Q'#1#8'AutoSize'#8#7'Caption'#6#137'Tree 2 uses V'
+'CL when initiating a drag operation. It also uses manual drag mode. Only ma'
+'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

10
components/virtualtreeview-unstable/demos/ole/Main.pas
View File

@ -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;

1
components/virtualtreeview-unstable/demos/ole/ole.lpi
View File

@ -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>

14
components/virtualtreeview-unstable/lclfunctions.inc
View File

@ -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';

1
components/virtualtreeview-unstable/vtlogger.pas
View File

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