From bccd8739a1ad8129d938fa6b56f1972a6df38bfe Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 17 Feb 2004 00:32:25 +0000 Subject: [PATCH] fixed TCustomImage.DoAutoSize fixing uninitialized vars git-svn-id: trunk@5202 - --- lcl/controls.pp | 138 +++++++++++++++++++---------- lcl/include/bitmap.inc | 4 + lcl/include/control.inc | 39 ++++++-- lcl/include/customimage.inc | 17 ++++ lcl/include/intfbaselcl.inc | 20 +++-- lcl/include/intfbasewinapi.inc | 5 +- lcl/include/lclintf.inc | 8 ++ lcl/include/lclintfh.inc | 7 +- lcl/include/promptdialog.inc | 5 +- lcl/include/treeview.inc | 55 ++++++------ lcl/interfaces/gtk/gtklclintf.inc | 15 ++++ lcl/interfaces/gtk/gtklclintfh.inc | 4 + lcl/interfaces/gtk/gtkwinapi.inc | 13 +-- 13 files changed, 235 insertions(+), 95 deletions(-) diff --git a/lcl/controls.pp b/lcl/controls.pp index 263ca59b82..6655e84a71 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -931,8 +931,8 @@ type FCompStyle: Byte; // enables (valid) use of 'IN' operator Function PerformTab(ForwardTab: boolean): Boolean; Virtual; // use overload to simulate default - procedure BeginDrag(Immediate: Boolean; Threshold: Integer); //overload; - procedure BeginDrag(Immediate: Boolean); //overload; + procedure BeginDrag(Immediate: Boolean; Threshold: Integer); + procedure BeginDrag(Immediate: Boolean); procedure BringToFront; function ColorIsStored: boolean; virtual; constructor Create(AOwner: TComponent);override; @@ -1662,7 +1662,8 @@ const function CNSendMessage(LM_Message: integer; Sender: TObject; data: pointer) : integer; Function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl; Function FindLCLWindow(const ScreenPos : TPoint) : TWinControl; -Function FindControl(Handle : hwnd) : TWinControl; +Function FindControl(Handle: hwnd): TWinControl; +Function FindOwnerControl(Handle: hwnd): TWinControl; function FindLCLControl(const ScreenPos: TPoint) : TControl; function SendAppMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): Longint; @@ -1718,17 +1719,31 @@ begin Result := SendMsgToInterface(LM_Message, Sender, Data); end; -{------------------------------------------------------------------------------} -{ FindControl } -{------------------------------------------------------------------------------} -function FindControl(Handle : hwnd) : TWinControl; +{------------------------------------------------------------------------------ + FindControl + + Returns the TWinControl owning the Handle. Handle can also be a child handle, + and does not need to be the Handle property of the Result. + IMPORTANT: So, in most cases: Result.Handle <> Handle in the params. +------------------------------------------------------------------------------} +function FindControl(Handle: hwnd): TWinControl; begin if Handle <> 0 then Result := TWinControl(GetProp(Handle,'WinControl')) else Result := nil; end; -function FindLCLControl(const ScreenPos : TPoint) : TControl; +function FindOwnerControl(Handle: hwnd): TWinControl; +begin + While Handle<>0 do begin + Result:=FindControl(Handle); + if Result<>nil then exit; + Handle:=GetParent(Handle); + end; + Result:=nil; +end; + +function FindLCLControl(const ScreenPos: TPoint) : TControl; var AWinControl: TWinControl; ClientPos: TPoint; @@ -1763,12 +1778,12 @@ begin MoveWindowOrgEx(dc,X,Y); end; -function DoControlMsg(handle:hwnd; var Message) : Boolean; +function DoControlMsg(Handle: hwnd; var Message) : Boolean; var Control : TWinControl; begin Result := False; - Control := FindControl(handle); + Control := FindOwnerControl(Handle); if Control <> nil then with TLMessage(Message) do Begin @@ -1778,20 +1793,39 @@ begin end; +{------------------------------------------------------------------------------- + procedure ClearDragObject; + + Set the global variable DragObject to nil. + If DragObjectAutoFree is set, then the DragObject was auto created by the LCL + and is freed here. +-------------------------------------------------------------------------------} +procedure ClearDragObject; +begin + if DragObjectAutoFree then begin + DragObjectAutoFree:=false; + FreeThenNil(DragObject); + end else + DragObject := nil; +end; + {------------------------------------------------------------------------------- Procedure DragInit(aDragObject: TDragObject; Immediate: Boolean; Threshold: Integer); + + Set the global variable DragObject. -------------------------------------------------------------------------------} Procedure DragInit(aDragObject: TDragObject; Immediate: Boolean; Threshold: Integer); Begin + if DragObject<>ADragObject then + ClearDragObject; DragObject := ADragObject; DragObject.DragTarget := nil; GetCursorPos(DragStartPos); DragObject.DragPos := DragStartPos; DragCapture := DragObject.Capture; DragThreshold := Threshold; - //save the cursor yet end; {------------------------------------------------------------------------------- @@ -1803,20 +1837,20 @@ var DragObject: TDragObject; ok: boolean; begin + {$IFDEF VerboseDrag} + writeln('DragInitControl ',Control.Name,':',Control.ClassName,' Immediate=',Immediate); + {$ENDIF} + ClearDragObject; DragControl := Control; ok:=false; try - DragObject := nil; - DragObjectAutoFree := False; - if Control.fDragKind = dkDrag then - begin + if Control.fDragKind = dkDrag then begin // initialize the DragControl. Note: This can change the DragControl Control.DoStartDrag(DragObject); // check if initialization was successful if DragControl = nil then Exit; // initialize DragObject, if not already done - if DragObject = nil then - Begin + if DragObject = nil then Begin DragObject := TDragControlObject.Create(Control); DragObjectAutoFree := True; End; @@ -1826,19 +1860,26 @@ begin DragInit(DragObject,Immediate,Threshold); ok:=true; finally - if not ok then + if not ok then begin DragControl := nil; + ClearDragObject; + end; end; end; {------------------------------------------------------------------------------- - Procedure DragTo(P : TPoint); + Procedure DragTo(const P : TPoint); + + -------------------------------------------------------------------------------} -Procedure DragTo(P : TPoint); +Procedure DragTo(const P: TPoint); Begin + {$IFDEF VerboseDrag} + writeln('DragTo P=',P.X,',',P.Y); + {$ENDIF} if (ActiveDrag = dopNone) and (Abs(DragStartPos.X - P.X) < DragThreshold) - and (Abs(DragStartPos.Y - P.Y) > DragThreshold) then + and (Abs(DragStartPos.Y - P.Y) < DragThreshold) then exit; @@ -1849,9 +1890,6 @@ Function DragMessage(Handle: HWND; Msg: TDragMessage; Source: TDragObject; var DragRec : TDragRec; Begin - Assert(False, 'Trace:******'); - Assert(False, 'Trace:DragMessage'); - Result := 0; if Handle <> 0 then Begin DragRec.Pos := Pos; @@ -1862,19 +1900,33 @@ Begin end; end; +{------------------------------------------------------------------------------- + Procedure DragDone(Drop : Boolean); + + Ends the current dragging operation. + Invokes DragMessage, + Frees the DragObject if autocreated by the LCL, + Finish: DragSave.Finished +-------------------------------------------------------------------------------} Procedure DragDone(Drop : Boolean); var Accepted : Boolean; DragSave : TDragObject; DragMsg : TDragMEssage; TargetPos : TPoint; + DragSaveAutoFree: Boolean; Begin - Assert(False, 'Trace:*************************'); - Assert(False, 'Trace:*********DRAGDONE********'); - + {$IFDEF VerboseDrag} + writeln('DragDone Drop=',Drop); + {$ENDIF} Accepted:=false; - if (DragObject = nil) or (DragObject.Cancelling) then Exit; + if (DragObject = nil) or DragObject.Cancelling then Exit; + + // take over the DragObject + // (to prevent auto destruction during the next operations) DragSave := DragObject; + DragSaveAutoFree:=DragObjectAutoFree; + DragObjectAutoFree:=false; try DragObject.Cancelling := True; DragObject.ReleaseCapture(DragCapture); @@ -1882,26 +1934,27 @@ Begin if DragObject.DragTarget <> nil then Begin dragMsg := dmDragDrop; - if not Accepted then - begin + if not Accepted then begin DragMsg := dmDragCancel; DragSave.FDragPos.X := 0; DragSave.FDragPos.Y := 0; TargetPos.X := 0; TargetPos.Y := 0; end; + // this can change DragObject DragMessage(DragSave.DragHandle,DragMsg,DragSave, DragSave.DragTarget,DragSave.DragPos); end; DragSave.Cancelling := False; DragSave.Finished(TObject(DragSave.DragTarget),TargetPos.X,TargetPos.Y,Accepted); - DragSave := nil; finally DragControl := nil; + if DragSaveAutoFree then begin + if DragSave=DragObject then + DragObject:=nil; + DragSave.Free; + end; end; - DragObject := nil; - if DragObjectAutoFree then DragSave.Free; - DragObjectAutoFree := False; end; {------------------------------------------------------------------------------ @@ -1915,15 +1968,7 @@ var Handle : HWND; begin Handle := WindowFromPoint(ScreenPos); - Result := nil; - while Handle <> 0 do - begin - Result := FindControl(Handle); - if Result <> nil then begin - Exit; - end; - Handle := GetParent(Handle); - end; + Result := FindOwnerControl(Handle); end; {------------------------------------------------------------------------------ @@ -1959,9 +2004,9 @@ end; Returns: ------------------------------------------------------------------------------} -function GetCaptureControl : TControl; +function GetCaptureControl: TControl; begin - Result := FindControl(GetCapture); + Result := FindOwnerControl(GetCapture); if (Result <> nil) and (CaptureControl <> nil) and (CaptureControl.Parent = Result) @@ -2312,6 +2357,9 @@ end. { ============================================================================= $Log$ + Revision 1.176 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.175 2004/02/13 15:49:54 mattias started advanced LCL auto sizing diff --git a/lcl/include/bitmap.inc b/lcl/include/bitmap.inc index 7015d73d4d..a378e21e3a 100644 --- a/lcl/include/bitmap.inc +++ b/lcl/include/bitmap.inc @@ -858,6 +858,7 @@ var IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter; begin + writeln('WriteStreamWithFPImage Self=',HexStr(Cardinal(Self),8),' ',Width,',',Height,' Using SaveStream=',(FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0)); if (FImage.SaveStream<>nil) and (FImage.SaveStream.Size>0) then begin DoWriteOriginal; exit; @@ -1058,6 +1059,9 @@ end; { ============================================================================= $Log$ + Revision 1.65 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.64 2004/02/11 11:40:18 mattias fixes for compilation under fpc 1.0.10 diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 8479d4c0ed..818e214bef 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -40,7 +40,8 @@ end; {------------------------------------------------------------------------------ Method: TControl.BeginDrag Params: Immediate: Drag behaviour - Threshold: default -1, distance to move before dragging starts + Threshold: distance to move before dragging starts + -1 uses the default value of Mouse.DragThreshold Returns: Nothing Starts the dragging of a control. If the Immediate flag is set, dragging @@ -331,7 +332,19 @@ end; store bounds in private variables -------------------------------------------------------------------------------} procedure TControl.DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); + + procedure BoundsOutOfBounds; + begin + writeln('TControl.DoSetBounds ',Name,':',ClassName, + ' Old=',Left,',',Top,',',Width,',',Height, + ' New=',aLeft,',',aTop,',',aWidth,',',aHeight, + ''); + RaiseGDBException('TControl.DoSetBounds '+Name+':'+ClassName+' Invalid bounds'); + end; + begin + if (AWidth>100000) or (AHeight>100000) then + BoundsOutOfBounds; {$IFDEF CHECK_POSITION} if csDesigning in ComponentState then writeln('TControl.DoSetBounds ',Name,':',ClassName, @@ -969,6 +982,9 @@ var S: TObject; P: TPoint; Begin + {$IFDEF VerboseDrag} + writeln('TControl.DoDragMsg DragMsg.DragMessage=',ord(DragMsg.DragMessage)); + {$ENDIF} S := DragMsg.Dragrec^.Source; Accepts := True; P:=ScreenToClient(DragMsg.Dragrec^.pos); @@ -976,11 +992,14 @@ Begin dmDragEnter, dmDragLeave, dmDragMove: begin case DragMsg.DragMessage of - dmDragEnter : DragOver(S,P.X,P.Y,dsDragEnter,Accepts); - dmDragLeave : DragOver(S,P.X,P.Y,dsDragLeave,Accepts); + dmDragEnter: DragOver(S,P.X,P.Y,dsDragEnter,Accepts); + dmDragLeave: DragOver(S,P.X,P.Y,dsDragLeave,Accepts); dmDragMove : DragOver(S,P.X,P.Y,dsDragMove,Accepts); end; - DragMsg.Result := ord(Accepts); + if Accepts then + DragMsg.Result := 1 + else + DragMsg.Result := 0; end; end; //case end; @@ -989,15 +1008,14 @@ end; { TControl.DragOver } {------------------------------------------------------------------------------} -Procedure TControl.DragOver(Source: TObject; X,Y : Integer; State : TDragState; var Accept:Boolean); +Procedure TControl.DragOver(Source: TObject; X,Y : Integer; State: TDragState; + var Accept:Boolean); begin Accept := False; - if Assigned(FOnDragOver) - then begin + if Assigned(FOnDragOver) then begin Accept := True; - //Do something else yet.... + FOnDragOver(Self,Source,X,Y,State,Accept); end; - end; {------------------------------------------------------------------------------} @@ -2753,6 +2771,9 @@ end; { ============================================================================= $Log$ + Revision 1.169 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.168 2004/02/13 15:49:54 mattias started advanced LCL auto sizing diff --git a/lcl/include/customimage.inc b/lcl/include/customimage.inc index a8d48017e7..9d70b28eb4 100644 --- a/lcl/include/customimage.inc +++ b/lcl/include/customimage.inc @@ -51,15 +51,32 @@ var ModifyHeight : Boolean; NewWidth: Integer; NewHeight: Integer; + + procedure OutOfBounds; + begin + writeln('TCustomImage.DoAutoSize NewWidth=',NewWidth, + ' NewHeight=',NewHeight, + ' ModifyWidth=',ModifyWidth, + ' Picture.Width=',Picture.Width, + ' ModifyHeight=',ModifyHeight, + ' Picture.Height=',Picture.Height, + ''); + RaiseGDBException(''); + end; + begin If AutoSize and not AutoSizing then begin AutoSizing := True; ModifyWidth := Align in [alLeft,alRight,alNone]; ModifyHeight := Align in [alTop,alBottom,alNone]; + NewWidth:=Width; + NewHeight:=Height; If ModifyWidth and (Picture.Width > 0) then NewWidth := Max(Picture.Width, Constraints.MinWidth); If ModifyHeight and (Picture.Height > 0) then NewHeight := Max(Picture.Height, Constraints.MinHeight); + if (NewWidth>100000) or (NewHeight>100000) then + OutOfBounds; if (NewWidth<>Width) or (NewHeight<>Height) then begin SetBounds(Left,Top,NewWidth,NewHeight); PictureChanged(Self); diff --git a/lcl/include/intfbaselcl.inc b/lcl/include/intfbaselcl.inc index dc9f8a435c..45c44ca044 100644 --- a/lcl/include/intfbaselcl.inc +++ b/lcl/include/intfbaselcl.inc @@ -229,6 +229,11 @@ begin Result := ''; end; +function TInterfaceBase.GetControlConstraints(Constraints: TObject): boolean; +begin + Result:=true; +end; + function TInterfaceBase.GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; begin @@ -242,11 +247,6 @@ begin Result := false; end; -function TInterfaceBase.GetControlConstraints(Constraints: TObject): boolean; -begin - Result:=true; -end; - function TInterfaceBase.GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var OriginDiff: TPoint): boolean; begin @@ -260,6 +260,13 @@ begin Result:=GetDC(WindowHandle); end; +function TInterfaceBase.GetLCLOwnerObject(Handle: HWnd): TObject; +begin + if Handle <> 0 + then Result := TObject(GetProp(Handle,'WinControl')) + else Result := nil; +end; + function TInterfaceBase.GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; begin Result := -1; @@ -606,6 +613,9 @@ end; { ============================================================================= $Log$ + Revision 1.17 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.16 2004/02/03 08:54:09 mattias Frame3D rect now var again diff --git a/lcl/include/intfbasewinapi.inc b/lcl/include/intfbasewinapi.inc index 224879dd15..83e6cbbed0 100644 --- a/lcl/include/intfbasewinapi.inc +++ b/lcl/include/intfbasewinapi.inc @@ -1089,7 +1089,7 @@ var CombineResult: Integer; begin Result:=false; - if (ARect.Left>=ARect.Right) or (ARect.Top>ARect.Bottom) + if (ARect.Left>=ARect.Right) or (ARect.Top>=ARect.Bottom) or not DCClipRegionValid(DC) then exit; ClipRGN:=CreateEmptyRegion; @@ -1398,6 +1398,9 @@ end; { ============================================================================= $Log$ + Revision 1.6 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.5 2004/02/10 00:05:03 mattias TSpeedButton now uses MaskBlt diff --git a/lcl/include/lclintf.inc b/lcl/include/lclintf.inc index f987a8487c..97ace49608 100644 --- a/lcl/include/lclintf.inc +++ b/lcl/include/lclintf.inc @@ -194,6 +194,11 @@ begin Result := InterfaceObject.GetDeviceSize(DC,p); end; +function GetLCLOwnerObject(Handle: HWnd): TObject; +begin + Result := InterfaceObject.GetLCLOwnerObject(Handle); +end; + function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; begin Result := InterfaceObject.GetListBoxIndexAtY(ListBox, y); @@ -506,6 +511,9 @@ end; { ============================================================================= $Log$ + Revision 1.15 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.14 2004/02/03 08:54:09 mattias Frame3D rect now var again diff --git a/lcl/include/lclintfh.inc b/lcl/include/lclintfh.inc index 75d9b2331d..76e7ac0436 100644 --- a/lcl/include/lclintfh.inc +++ b/lcl/include/lclintfh.inc @@ -56,6 +56,7 @@ function CreateRegionCopy(SrcRGN: hRGN): hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ function DCClipRegionValid(DC: HDC): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetBitmapRawImageDescription(Bitmap: HBITMAP; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetClientBounds(handle : HWND; var ARect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -65,6 +66,7 @@ function GetDCOriginRelativeToWindow(PaintDC: HDC; WindowHandle: HWND; var Origi function GetDesignerDC(WindowHandle: HWND): HDC; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetDeviceRawImageDescription(DC: HDC; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetDeviceSize(DC: HDC; var p: TPoint): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +function GetLCLOwnerObject(Handle: HWnd): TObject; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRect): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetNotebookTabIndexAtPos(Handle: HWND; const ClientPos: TPoint): integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -77,8 +79,6 @@ function GetWindowRelativePosition(Handle : hwnd; var Left, Top: integer): boole function Frame(DC: HDC; const ARect: TRect): Integer; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function Frame3d(DC: HDC; var ARect: TRect; const FrameWidth : integer; const Style : TGraphicsBevelCut): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} -function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} - function InvalidateFrame(aHandle : HWND; ARect : pRect; bErase : Boolean; BorderWidth: integer) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function LoadStockPixmap(StockID: longint) : HBitmap; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -148,6 +148,9 @@ procedure RaiseLastOSError; { ============================================================================= $Log$ + Revision 1.15 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.14 2004/02/03 08:54:09 mattias Frame3D rect now var again diff --git a/lcl/include/promptdialog.inc b/lcl/include/promptdialog.inc index 5246623050..aa5d486a5a 100644 --- a/lcl/include/promptdialog.inc +++ b/lcl/include/promptdialog.inc @@ -68,7 +68,7 @@ begin // focus the next button to the left or right // search old focused button - OldFocusControl:=FindControl(LCLIntf.GetFocus); + OldFocusControl:=FindOwnerControl(LCLIntf.GetFocus); if (OldFocusControl=nil) or (GetParentForm(OldFocusControl)<>Self) or (not (OldFocusControl is TButton)) then begin @@ -377,6 +377,9 @@ end; { $Log$ + Revision 1.11 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.10 2003/10/16 16:43:57 ajgenius fix opaque brush diff --git a/lcl/include/treeview.inc b/lcl/include/treeview.inc index 820ba93ab9..bd81a82636 100644 --- a/lcl/include/treeview.inc +++ b/lcl/include/treeview.inc @@ -4024,33 +4024,31 @@ begin end; procedure TCustomTreeView.DoStartDrag(var DragObject: TDragObject); -{var - ImageHandle: HImageList; - DragNode: TTreeNode; - P: TPoint;} +var + P: TPoint; begin + {$IFDEF VerboseDrag} + writeln('TCustomTreeView.DoStartDrag A '); + {$ENDIF} inherited DoStartDrag(DragObject); - {DragNode := FDragNode; FLastDropTarget := nil; - FDragNode := nil; - if DragNode = nil then begin + if FDragNode = nil then begin GetCursorPos(P); - with ScreenToClient(P) do DragNode := GetNodeAt(X, Y); + with ScreenToClient(P) do FDragNode := GetNodeAt(X, Y); + {$IFDEF VerboseDrag} + if FDragNode<>nil then + writeln('TCustomTreeView.DoStartDrag DragNode=',FDragNode.Text) + else + writeln('TCustomTreeView.DoStartDrag DragNode=nil'); + {$ENDIF} end; - if DragNode <> nil then begin - // ToDo: implement Drag&Drop - ImageHandle := 0; TreeView_CreateDragImage(Handle, DragNode.ItemId); - if ImageHandle <> 0 then - with FDragImage do - begin - Handle := ImageHandle; - SetDragImage(0, 2, 2); - end; - end;} end; procedure TCustomTreeView.DoEndDrag(Target: TObject; X, Y: Integer); begin + {$IFDEF VerboseDrag} + writeln('TCustomTreeView.DoEndDrag A '); + {$ENDIF} inherited DoEndDrag(Target, X, Y); FLastDropTarget := nil; end; @@ -4060,7 +4058,9 @@ var P: TPoint; begin inherited CMDrag(AMessage); + {$IFDEF VerboseDrag} writeln('TCustomTreeView.CMDrag ',ord(AMessage.DragMessage)); + {$ENDIF} with AMessage, DragRec^ do case DragMessage of dmDragMove: @@ -4085,7 +4085,9 @@ var Node: TTreeNode; begin Node := GetNodeAt(X, Y); + {$IFDEF VerboseDrag} writeln('TCustomTreeView.DoDragOver ',Node<>nil,' ',Node <> DropTarget,' ',Node = FLastDropTarget); + {$ENDIF} if (Node <> nil) and ((Node <> DropTarget) or (Node = FLastDropTarget)) then begin @@ -4609,7 +4611,11 @@ begin CursorNode.Expanded:=not CursorNode.Expanded; end else if x>=CursorNode.DisplayTextLeft then begin // mousedown occured in text -> select node and begin drag operation - Include(FStates,tvsMouseCapture); + {$IFDEF VerboseDrag} + writeln('TCustomTreeView.MouseDown In Text ',Name,':',ClassName,' MouseCapture=',MouseCapture); + {$ENDIF} + if MouseCapture then + Include(FStates,tvsMouseCapture); if not (tvoAllowMultiselect in Options) then begin Selected:=CursorNode; end else begin @@ -4626,7 +4632,7 @@ begin end; end; end; - bStartDrag := true; + bStartDrag := tvsMouseCapture in FStates; end; end; if (bStartDrag) then begin @@ -4634,20 +4640,15 @@ begin writeln('TCustomTreeView.MouseDown A bStartDrag ',Name,':',ClassName,' '); {$ENDIF} FDragNode:=CursorNode; - Include(fStates, tvsWaitForDragging); - end; - if Button=mbMiddle then begin - // insert primary selection text - + Include(fStates,tvsWaitForDragging); end; end; - //LCLLinux.SetFocus(Handle); end; procedure TCustomTreeView.MouseMove(Shift: TShiftState; X, Y: Integer); begin inherited MouseMove(Shift, x, y); - if {MouseCapture and} (tvsWaitForDragging in fStates) then begin + if (tvsWaitForDragging in fStates) then begin if (Abs(fMouseDownX - X) >= GetSystemMetrics(SM_CXDRAG)) or (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG)) then begin diff --git a/lcl/interfaces/gtk/gtklclintf.inc b/lcl/interfaces/gtk/gtklclintf.inc index 887814be6d..8fe276b1bc 100644 --- a/lcl/interfaces/gtk/gtklclintf.inc +++ b/lcl/interfaces/gtk/gtklclintf.inc @@ -96,6 +96,18 @@ begin end; end; +{------------------------------------------------------------------------------ + function TGTKObject.GetLCLOwnerObject(Handle: HWnd): TObject; + + ------------------------------------------------------------------------------} +function TGTKObject.GetLCLOwnerObject(Handle: HWnd): TObject; +begin + if Handle<>0 then + Result:=GetNearestLCLObject(PGtkWidget(Handle)) + else + Result:=nil; +end; + {------------------------------------------------------------------------------ Function: GetListBoxIndexAtY Params: ListBox: @@ -395,6 +407,9 @@ end; { ============================================================================= $Log$ + Revision 1.15 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.14 2004/02/02 15:46:19 mattias implemented basic TSplitter, still many ToDos diff --git a/lcl/interfaces/gtk/gtklclintfh.inc b/lcl/interfaces/gtk/gtklclintfh.inc index 1aa228c1fd..1c58b890b5 100644 --- a/lcl/interfaces/gtk/gtklclintfh.inc +++ b/lcl/interfaces/gtk/gtklclintfh.inc @@ -32,6 +32,7 @@ //##apiwiz##sps## // Do not remove function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; override; function GetControlConstraints(Constraints: TObject): boolean; override; +function GetLCLOwnerObject(Handle: HWnd): TObject; override; function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override; function GetListBoxItemRect(ListBox: TComponent; Index: integer; var ARect: TRect): boolean; override; @@ -47,6 +48,9 @@ procedure StatusBarUpdate(StatusBar: TObject); override; { ============================================================================= $Log$ + Revision 1.12 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.11 2004/02/02 15:46:19 mattias implemented basic TSplitter, still many ToDos diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index 41bd46cb0c..5926186dfb 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -8191,7 +8191,7 @@ function TgtkObject.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; end; if (OldListItem=AfterListItem) or (OldListItem^.next=AfterListItem) then exit; - writeln('TgtkObject.SetWindowPos Moving GList entry'); + //writeln('TgtkObject.SetWindowPos Moving GList entry'); // reorder // This trick does not work properly @@ -8206,7 +8206,7 @@ function TgtkObject.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; procedure SetZOrderOnLayoutWidget(Widget, LayoutWidget: PGtkWidget); begin - writeln('ToDO: SetZOrderOnLayoutWidget'); + //writeln('ToDO: SetZOrderOnLayoutWidget'); end; var @@ -8214,12 +8214,12 @@ var FixedWidget: PGtkWidget; begin Widget:=PGtkWidget(hWnd); - writeln('[TgtkObject.SetWindowPos] ',GetWidgetDebugReport(Widget), + {writeln('[TgtkObject.SetWindowPos] ',GetWidgetDebugReport(Widget), ' Top=',hWndInsertAfter=HWND_TOP, ' SWP_NOZORDER=',(SWP_NOZORDER and uFlags)<>0, ' SWP_NOSIZE=',(SWP_NOSIZE and uFlags)<>0, ' SWP_NOMOVE=',(SWP_NOMOVE and uFlags)<>0, - ''); + '');} if GtkWidgetIsA(Widget,GTK_TYPE_WINDOW) then begin { case hWndInsertAfter of HWND_BOTTOM: ; //gdk_window_lower(Widget^.Window); @@ -8231,7 +8231,7 @@ begin FixedWidget:=Widget^.Parent; if FixedWidget=nil then exit; - writeln('TgtkObject.SetWindowPos ZOrdering .. on ',GetWidgetDebugReport(FixedWidget)); + //writeln('TgtkObject.SetWindowPos ZOrdering .. on ',GetWidgetDebugReport(FixedWidget)); if GtkWidgetIsA(FixedWidget,GTK_Fixed_Get_Type) then begin // parent's client area is a gtk_fixed widget SetZOrderOnFixedWidget(Widget,FixedWidget); @@ -8743,6 +8743,9 @@ end; { ============================================================================= $Log$ + Revision 1.330 2004/02/17 00:32:25 mattias + fixed TCustomImage.DoAutoSize fixing uninitialized vars + Revision 1.329 2004/02/13 15:49:54 mattias started advanced LCL auto sizing