paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 14:09:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed TCustomImage.DoAutoSize fixing uninitialized vars

Browse Source 
git-svn-id: trunk@5202 -
This commit is contained in:
mattias 2004-02-17 00:32:25 +00:00
parent 8bedd8b74f
commit bccd8739a1
13 changed files with 235 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
lcl/controls.pp
View File

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

4
lcl/include/bitmap.inc
View File

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

39
lcl/include/control.inc
View File

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

17
lcl/include/customimage.inc
View File

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

20
lcl/include/intfbaselcl.inc
View File

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

5
lcl/include/intfbasewinapi.inc
View File

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

8
lcl/include/lclintf.inc
View File

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

7
lcl/include/lclintfh.inc
View File

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

5
lcl/include/promptdialog.inc
View File

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

55
lcl/include/treeview.inc
View File

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

15
lcl/interfaces/gtk/gtklclintf.inc
View File

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

4
lcl/interfaces/gtk/gtklclintfh.inc
View File

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

13
lcl/interfaces/gtk/gtkwinapi.inc
View File

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