fixed SetComboHeight in win32 intf and finddeclaration of overloaded proc definition

git-svn-id: trunk@4514 -
This commit is contained in:
mattias 2003-08-23 11:30:51 +00:00
parent f9aa787cd3
commit f3b46f7896
12 changed files with 214 additions and 70 deletions

View File

@ -601,7 +601,9 @@ type
FirstParameterNode2: TCodeTreeNode;
Params: TFindDeclarationParams;
CompatibilityList: TTypeCompatibilityList): TTypeCompatibility;
function CreateParamExprList(StartPos: integer;
function CreateParamExprListFromStatement(StartPos: integer;
Params: TFindDeclarationParams): TExprTypeList;
function CreateParamExprListFromProcNode(ProcNode: TCodeTreeNode;
Params: TFindDeclarationParams): TExprTypeList;
function ContextIsDescendOf(
const DescendContext, AncestorContext: TFindContext;
@ -4528,7 +4530,7 @@ begin
ReadNextAtom;
if not AtomIsChar('(') then
exit;
ParamList:=CreateParamExprList(CurPos.StartPos,Params);
ParamList:=CreateParamExprListFromStatement(CurPos.StartPos,Params);
if (CompareIdentifiers(IdentPos,'PREC')=0)
or (CompareIdentifiers(IdentPos,'SUCC')=0) then begin
// the PREC and SUCC of a expression has the same type as the expression
@ -4722,6 +4724,9 @@ begin
i:=0;
while (ParamNode<>nil) and (i<ExprParamList.Count) do begin
ParamCompatibility:=IsCompatible(ParamNode,ExprParamList.Items[i],Params);
{$IFDEF ShowExprEval}
writeln('[TFindDeclarationTool.IsParamListCompatible] B ',ExprTypeToString(ExprParamList.Items[i]));
{$ENDIF}
if CompatibilityList<>nil then
CompatibilityList[i]:=ParamCompatibility;
if ParamCompatibility=tcIncompatible then begin
@ -4919,22 +4924,43 @@ begin
Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier);
StartContextNode:=Params.IdentifierTool.FindDeepestNodeAtPos(
Params.IdentifierTool.CurPos.StartPos,true);
if (StartContextNode<>nil)
and (StartContextNode.Desc in AllPascalStatements) then begin
Params.Save(OldInput);
Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier);
Params.Flags:=fdfDefaultForExpressions+Params.Flags*fdfGlobals;
Params.ContextNode:=StartContextNode;
Params.OnIdentifierFound:=@Params.IdentifierTool.CheckSrcIdentifier;
Params.IdentifierTool.ReadNextAtom;
Params.FoundProc^.ExprInputList:=
Params.IdentifierTool.CreateParamExprList(
if (StartContextNode<>nil) then begin
if (StartContextNode.Desc in AllPascalStatements) then begin
{$IFDEF ShowProcSearch}
writeln('[TFindDeclarationTool.CheckSrcIdentifier]',
' Indent=',GetIdentifier(Params.Identifier),
' Creating Input Expression List for statement ...'
);
{$ENDIF}
Params.Save(OldInput);
Params.IdentifierTool.MoveCursorToCleanPos(Params.Identifier);
Params.Flags:=fdfDefaultForExpressions+Params.Flags*fdfGlobals;
Params.ContextNode:=StartContextNode;
Params.OnIdentifierFound:=@Params.IdentifierTool.CheckSrcIdentifier;
Params.IdentifierTool.ReadNextAtom;
Params.FoundProc^.ExprInputList:=
Params.IdentifierTool.CreateParamExprListFromStatement(
Params.IdentifierTool.CurPos.EndPos,Params);
Params.Load(OldInput);
Params.Load(OldInput);
end
else if (StartContextNode.Desc in [ctnProcedureHead,ctnProcedure])
then begin
{$IFDEF ShowProcSearch}
writeln('[TFindDeclarationTool.CheckSrcIdentifier]',
' Indent=',GetIdentifier(Params.Identifier),
' Creating Input Expression List for proc node ...'
);
{$ENDIF}
Params.FoundProc^.ExprInputList:=
Params.IdentifierTool.CreateParamExprListFromProcNode(
StartContextNode,Params);
end;
end;
end;
if Params.FoundProc^.ExprInputList=nil then
if Params.FoundProc^.ExprInputList=nil then begin
// create expression list without params
Params.FoundProc^.ExprInputList:=TExprTypeList.Create;
end;
end;
// create compatibility lists for params
@ -5164,8 +5190,8 @@ begin
Result:=vatNone;
end;
function TFindDeclarationTool.CreateParamExprList(StartPos: integer;
Params: TFindDeclarationParams): TExprTypeList;
function TFindDeclarationTool.CreateParamExprListFromStatement(
StartPos: integer; Params: TFindDeclarationParams): TExprTypeList;
var ExprType: TExpressionType;
BracketClose: char;
ExprStartPos, ExprEndPos: integer;
@ -5177,7 +5203,7 @@ var ExprType: TExpressionType;
begin
{$IFDEF ShowExprEval}
writeln('[TFindDeclarationTool.CreateParamExprList] ',
writeln('[TFindDeclarationTool.CreateParamExprListFromStatement] ',
'"',copy(Src,StartPos,40),'" Context=',Params.ContextNode.DescAsString);
{$ENDIF}
Result:=TExprTypeList.Create;
@ -5223,12 +5249,38 @@ begin
end;
end;
{$IFDEF ShowExprEval}
writeln('[TFindDeclarationTool.CreateParamExprList] END ',
writeln('[TFindDeclarationTool.CreateParamExprListFromStatement] END ',
'ParamCount=',Result.Count,' "',copy(Src,StartPos,40),'"');
writeln(' ExprList=[',Result.AsString,']');
{$ENDIF}
end;
function TFindDeclarationTool.CreateParamExprListFromProcNode(
ProcNode: TCodeTreeNode; Params: TFindDeclarationParams): TExprTypeList;
var
ExprType: TExpressionType;
ParamNode: TCodeTreeNode;
begin
{$IFDEF ShowExprEval}
writeln('[TFindDeclarationTool.CreateParamExprListFromProcNode] ',
'"',copy(Src,ProcNode.StartPos,40),'" Context=',ProcNode.DescAsString);
{$ENDIF}
Result:=TExprTypeList.Create;
ParamNode:=GetFirstParameterNode(ProcNode);
while ParamNode<>nil do begin
// find expression type
ExprType:=ConvertNodeToExpressionType(ParamNode,Params);
// add expression type to list
Result.Add(ExprType);
ParamNode:=ParamNode.NextBrother;
end;
{$IFDEF ShowExprEval}
writeln('[TFindDeclarationTool.CreateParamExprListFromProcNode] END ',
'ParamCount=',Result.Count,' "',copy(Src,ProcNode.StartPos,40),'"');
writeln(' ExprList=[',Result.AsString,']');
{$ENDIF}
end;
function TFindDeclarationTool.CompatibilityList1IsBetter( List1,
List2: TTypeCompatibilityList; ListCount: integer): boolean;
// List1 and List2 should only contain tcCompatible and tcExact values

View File

@ -22,7 +22,6 @@
For an usage example, see the object inspector.
ToDo:
- pass selection to form editor
- icons
- pass keys to form editor
- drag&drop: change parent and position

View File

@ -22,6 +22,7 @@
ToDo:
- backgroundcolor=clNone
- auto sizing of component tree if no pair splitter
- pair splitter
- default values for property editors
- set to default value

View File

@ -2809,35 +2809,30 @@ begin
Left:=4;
Top:=4;
Width:=170;
Height:=23;
end;
with MaxRecentOpenFilesComboBox do begin
Left:=MaxRecentOpenFilesLabel.Left+MaxRecentOpenFilesLabel.Width+2;
Top:=MaxRecentOpenFilesLabel.Top;
Width:=60;
Height:=25;
end;
with MaxRecentProjectFilesLabel do begin
Left:=MaxRecentOpenFilesLabel.Left;
Top:=MaxRecentOpenFilesLabel.Top+MaxRecentOpenFilesLabel.Height+3;
Width:=MaxRecentOpenFilesLabel.Width;
Height:=MaxRecentOpenFilesLabel.Height;
end;
with MaxRecentProjectFilesComboBox do begin
Left:=MaxRecentProjectFilesLabel.Left+MaxRecentProjectFilesLabel.Width+2;
Top:=MaxRecentProjectFilesLabel.Top;
Width:=60;
Height:=25;
end;
with OpenLastProjectAtStartCheckBox do begin
Left:=4;
Top:=MaxRecentProjectFilesLabel.Top+MaxRecentProjectFilesLabel.Height+5;
Width:=MaxX-2*Left;
Height:=23;
end;
y:=OpenLastProjectAtStartCheckBox.Top

View File

@ -324,11 +324,13 @@ type
{ TDragObject }
TDragObject = class;
TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
TDragMode = (dmManual , dmAutomatic);
TDragKind = (dkDrag, dkDock);
TDragOperation = (dopNone, dopDrag, dopDock);
TDragMessage = (dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop,
dmDragCancel,dmFindTarget);
TDragOverEvent = Procedure(Sender, Source: TObject;
@ -401,6 +403,7 @@ type
procedure Finished(Target: TObject; X, Y: Integer; Accepted: Boolean); override;
Public
constructor Create(AControl: TControl); virtual;
procedure Assign(Source: TDragObject); override;
property Control: TControl read FControl write FControl;
end;
@ -1168,6 +1171,7 @@ type
Function GetCapture : HWND;
Procedure SetCursorPos(value : TPoint);
Function GetCursorPos : TPoint;
function GetIsDragging: Boolean;
public
constructor Create;
destructor Destroy; override;
@ -1175,6 +1179,7 @@ type
property CursorPos : TPoint read GetCursorPos write SetCursorPos;
property DragImmediate : Boolean read FDragImmediate write FDragImmediate default True;
property DragThreshold : Integer read FDragThreshold write FDragThreshold default 5;
property IsDragging: Boolean read GetIsDragging;
end;
@ -1235,13 +1240,14 @@ uses
var
CaptureControl: TControl;
DragCapture : HWND;
DragControl : TControl;
DragObjectAutoFree : Boolean;
DragObject : TDragObject;
//DragSaveCursor : HCURSOR;
DragStartPos : TPoint;
//DragThreshold : Integer;
DragCapture: HWND;
DragControl: TControl;
DragObjectAutoFree: Boolean;
DragObject: TDragObject;
//DragSaveCursor: HCURSOR;
DragStartPos: TPoint;
DragThreshold: Integer;
ActiveDrag: TDragOperation;
procedure Register;
begin
@ -1317,7 +1323,10 @@ begin
end;
{DragIntit}
{-------------------------------------------------------------------------------
Procedure DragInit(aDragObject: TDragObject; Immediate: Boolean;
Threshold: Integer);
-------------------------------------------------------------------------------}
Procedure DragInit(aDragObject: TDragObject; Immediate: Boolean;
Threshold: Integer);
Begin
@ -1326,15 +1335,17 @@ Begin
GetCursorPos(DragStartPos);
DragObject.DragPos := DragStartPos;
DragCapture := DragObject.Capture;
//DragThreshold := Threshold;
DragThreshold := Threshold;
//save the cursor yet
end;
{Draginitcontrol}
Procedure DragInitControl(Control : TControl; Immediate : Boolean;
Threshold : Integer);
{-------------------------------------------------------------------------------
Procedure DragInitControl(Control : TControl; Immediate : Boolean;
-------------------------------------------------------------------------------}
Procedure DragInitControl(Control: TControl; Immediate: Boolean;
Threshold: Integer);
var
DragObject : TDragObject;
DragObject: TDragObject;
ok: boolean;
begin
DragControl := Control;
@ -1344,13 +1355,18 @@ begin
DragObjectAutoFree := False;
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
DragObject := TDragControlObject.Create(Control);
DragObjectAutoFree := True;
End;
end else if Control.fDragKind = dkDock then begin
// ToDo: docking
end;
DragInit(DragObject,Immediate,Threshold);
ok:=true;
@ -1360,14 +1376,21 @@ begin
end;
end;
{-------------------------------------------------------------------------------
Procedure DragTo(P : TPoint);
-------------------------------------------------------------------------------}
Procedure DragTo(P : TPoint);
Begin
Assert(False, 'Trace:********************************************');
Assert(False, 'Trace:*******************D R A G T O***************');
Assert(False, 'Trace:********************************************');
if (ActiveDrag = dopNone)
and (Abs(DragStartPos.X - P.X) < DragThreshold)
and (Abs(DragStartPos.Y - P.Y) > DragThreshold) then
exit;
end;
Function DragMessage(Handle : HWND; Msg : TDragMessage; Source : TDragObject; Target : Pointer; const Pos : TPoint): longint;
Function DragMessage(Handle: HWND; Msg: TDragMessage; Source: TDragObject;
Target: Pointer; const Pos: TPoint): longint;
var
DragRec : TDragRec;
Begin
@ -1384,7 +1407,6 @@ Begin
end;
end;
Procedure DragDone(Drop : Boolean);
var
Accepted : Boolean;
@ -1635,6 +1657,9 @@ end.
{ =============================================================================
$Log$
Revision 1.142 2003/08/23 11:30:50 mattias
fixed SetComboHeight in win32 intf and finddeclaration of overloaded proc definition
Revision 1.141 2003/08/21 13:04:10 mattias
implemented insert marks for TTreeView

View File

@ -1,3 +1,5 @@
// included by controls.pp
{******************************************************************************
TBaseDragControlObject
******************************************************************************
@ -18,25 +20,31 @@
constructor TBaseDragControlObject.Create(AControl : TControl);
begin
FControl := AControl;
FControl := AControl;
end;
Procedure TBaseDragControlObject.Finished(Target: TObject; X, Y: Integer; Accepted: Boolean);
procedure TBaseDragControlObject.Assign(Source: TDragObject);
begin
inherited Assign(Source);
if Source is TBaseDragControlObject then
FControl := TBaseDragControlObject(Source).Control;
end;
Procedure TBaseDragControlObject.Finished(Target: TObject; X, Y: Integer;
Accepted: Boolean);
Begin
Assert(False, 'Trace:5-1');
if Not Accepted then
Begin
fControl.DragCanceled;
Target := nil;
end;
Assert(False, 'Trace:5-2');
EndDrag(Target,X,Y);
if Not Accepted then
Begin
fControl.DragCanceled;
Target := nil;
end;
EndDrag(Target,X,Y);
end;
procedure TBaseDragControlObject.EndDrag(Target : TObject; X,Y : Integer);
procedure TBaseDragControlObject.EndDrag(Target: TObject; X,Y : Integer);
Begin
FControl.DoEndDrag(Target,X,Y);
end;
// included by controls.pp

View File

@ -50,15 +50,20 @@ procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);
var
P : TPoint;
begin
// start a drag operation, if not already running
if (DragControl = nil) or (Pointer(DragControl) = Pointer($FFFFFFFF)) then
Begin
DragControl := nil;
if csLButtonDown in ControlState then
Begin
// if the last mouse down was not followed by a mouse up, simulate a
// mouse up. This way applications need only to react to mouse up to
// clean up.
if csLButtonDown in ControlState then begin
GetCursorPos(p);
P := ScreenToClient(p);
Perform(LM_LBUTTONUP,0,Longint(PointToSmallPoint(p)));
end;
if Threshold < 0 then
Threshold := Mouse.DragThreshold;
if Pointer(DragControl) <> Pointer($FFFFFFFF) then
@ -1147,7 +1152,14 @@ begin
then begin
Assert(False, 'Trace:Begin AutoDrag called');
BeginAutoDrag;
exit;
{ The VCL holds up the mouse down for dmAutomatic
and sends it, when it decides, if it is a drag operation or
not.
This decision requires full control of focus and mouse, which
not all LCL interfaces provide. Therefore the mouse down event
is sent immediately.
}
// VCL: exit;
end;
Include(FControlState,csLButtonDown);
end;
@ -2468,6 +2480,9 @@ end;
{ =============================================================================
$Log$
Revision 1.149 2003/08/23 11:30:50 mattias
fixed SetComboHeight in win32 intf and finddeclaration of overloaded proc definition
Revision 1.148 2003/08/22 07:58:38 mattias
started componenttree

View File

@ -57,5 +57,10 @@ Begin
Result := P;
end;
function TMouse.GetIsDragging: Boolean;
begin
Result := ActiveDrag <> dopNone;
end;
// included by controls.pp

View File

@ -2362,6 +2362,7 @@ begin
NewTop:=FBoundsRealized.Top;
if HandleAllocated then
GetWindowRelativePosition(Handle,NewLeft,NewTop);
//writeln('TWinControl.WMSize B ',Name,':',ClassName,' ',NewLeft,',',NewTop);
FBoundsRealized:=Bounds(NewLeft,NewTop,Message.Width,Message.Height);
end;
@ -2947,6 +2948,9 @@ end;
{ =============================================================================
$Log$
Revision 1.161 2003/08/23 11:30:50 mattias
fixed SetComboHeight in win32 intf and finddeclaration of overloaded proc definition
Revision 1.160 2003/08/21 13:04:10 mattias
implemented insert marks for TTreeView

View File

@ -40,10 +40,15 @@ Begin
Result := StrComp(AStr, BStr);
end;
Procedure SetComboHeight(Handle:THandle;ALeft,Atop,AWidth,AHeight,AEditHeight:Integer);
Procedure SetComboHeight(Sender: TObject;
ALeft, ATop, AWidth, AHeight, AEditHeight:Integer);
var
ComboHandle: HWnd;
begin
MoveWindow(Handle,ALeft,ATop,AWidth,AHeight,true);
SendMessage(Handle, WM_SIZE, 0, MakeLParam(AWidth,AEditHeight));
LCLBoundsToWin32Bounds(Sender,ALeft, ATop, AWidth, AHeight);
ComboHandle:=TWinControl(Sender).Handle;
MoveWindow(ComboHandle,ALeft,ATop,AWidth,AHeight,true);
SendMessage(ComboHandle, WM_SIZE, 0, MakeLParam(AWidth,AEditHeight));
end;
{*************************************************************}
{ TWin32ListStringList methods }
@ -145,9 +150,9 @@ Begin
if FSender.FCompStyle=csComboBox Then
begin
if Count = 0 then
SetComboHeight(FWin32List,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FItemHeight + 2,FEditHeight)
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FItemHeight + 2,FEditHeight)
else
SetComboHeight(FWin32List,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FDropDownCount*FItemHeight + 2,FEditHeight);
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FDropDownCount*FItemHeight + 2,FEditHeight);
end;
End
Else
@ -195,7 +200,8 @@ End;
Procedure TWin32ListStringList.Clear;
Begin
if FSender.FCompStyle=csComboBox Then
SetComboHeight(FWin32List,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FItemHeight + 2,FEditHeight);
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,
FEditHeight + FItemHeight + 2,FEditHeight);
SendMessage(FWin32List,FFlagResetContent, 0, 0);
End;
@ -209,7 +215,8 @@ Procedure TWin32ListStringList.Delete(Index: Integer);
Begin
If (FSender.FCompStyle = csComboBox)
and (GetCount <= 1) Then
SetComboHeight(FWin32List,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FItemHeight + 2,FEditHeight);
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,
FEditHeight + FItemHeight + 2,FEditHeight);
SendMessage(FWin32List,FFlagDeleteString, Index, 0);
End;
@ -223,7 +230,8 @@ Procedure TWin32ListStringList.Insert(Index: Integer; Const S: String);
Begin
If (FSender.FCompStyle = csComboBox)
and (GetCount = 0) Then
SetComboHeight(FWin32List,FSender.Left,FSender.Top,FSender.Width,FEditHeight + FItemHeight + 2,FEditHeight);
SetComboHeight(FSender,FSender.Left,FSender.Top,FSender.Width,
FEditHeight + FItemHeight + 2,FEditHeight);
If FSorted Then
SendMessage(FWin32List,FFlagAddString, 0, LPARAM(PChar(S)))
Else
@ -397,6 +405,9 @@ End;
{ =============================================================================
$Log$
Revision 1.14 2003/08/23 11:30:51 mattias
fixed SetComboHeight in win32 intf and finddeclaration of overloaded proc definition
Revision 1.13 2003/08/13 21:23:10 mattias
fixed log

View File

@ -1690,14 +1690,31 @@ End;
Resize a window
------------------------------------------------------------------------------}
Procedure TWin32Object.ResizeChild(Sender: TObject; Left, Top, Width, Height: Integer);
Procedure TWin32Object.ResizeChild(Sender: TObject;
Left, Top, Width, Height: Integer);
Var
Handle: HWND;
AWinControl: TWinControl;
{$IFDEF VerboseSizeMsg}
OldLeft: Integer;
OldTop: Integer;
{$ENDIF}
Begin
Handle := (Sender As TWinControl).Handle;
AWinControl:=TWinControl(Sender);
if not AWinControl.HandleAllocated then exit;
Handle := AWinControl.Handle;
{$IFDEF VerboseSizeMsg}
OldLeft:=Left;
OldTop:=Top;
{$ENDIF}
LCLBoundsToWin32Bounds(Sender, Left, Top, Width, Height);
If Handle <> 0 Then
MoveWindow(Handle, Left, Top, Width, Height, True);
{$IFDEF VerboseSizeMsg}
writeln('TWin32Object.ResizeChild A ',AWinControl.Name,':',AWinControl.ClassName,
' LCL=',OldLeft,',',OldTop,',',Width,',',Height,
' Win32=',Left,',',Top,',',Width,',',Height,
'');
{$ENDIF}
MoveWindow(Handle, Left, Top, Width, Height, True);
End;
{------------------------------------------------------------------------------
@ -1833,6 +1850,9 @@ Begin
Width := TControl(Sender).Width;
Assert(False, 'Trace:Setting dimentions');
LCLBoundsToWin32Bounds(Sender, Left, Top, Width, Height);
{$IFDEF VerboseSizeMsg}
writeln('TWin32Object.CreateComponent A ',TControl(Sender).Name,':',TControl(Sender).ClassName,' ',Left,',',Top,',',Width,',',Height);
{$ENDIF}
End
Else If (Sender Is TMenuItem) Then
Begin
@ -2811,6 +2831,9 @@ End;
{
$Log$
Revision 1.93 2003/08/23 11:30:51 mattias
fixed SetComboHeight in win32 intf and finddeclaration of overloaded proc definition
Revision 1.92 2003/08/22 07:58:38 mattias
started componenttree

View File

@ -1452,10 +1452,13 @@ begin
begin
Windows.ScreenToClient(ParentHandle,@LeftTop);
OwnerObject := TObject(GetProp(ParentHandle, 'Lazarus'));
if OwnerObject is TWinControl then begin
if (OwnerObject<>nil) and (OwnerObject is TWinControl) then begin
TheWinControl:=TWinControl(OwnerObject);
if TheWinControl is TGroupBox then
begin
{$IFDEF VerboseSizeMsg}
writeln('TWin32Object.GetWindowRelativePosition A ',TheWinControl.Name,':',TheWinControl.ClassName,' Win32=',R.Left,',',R.Top,' Moved=',LeftTop.X,',',LeftTop.Y);
{$ENDIF}
DC := GetDC(ParentHandle);
GetTextMetrics(DC, TM);
dec(LeftTop.Y,TM.TMHeight);
@ -2419,6 +2422,9 @@ end;
{ =============================================================================
$Log$
Revision 1.56 2003/08/23 11:30:51 mattias
fixed SetComboHeight in win32 intf and finddeclaration of overloaded proc definition
Revision 1.55 2003/08/21 13:04:10 mattias
implemented insert marks for TTreeView