started codeexplorer

git-svn-id: trunk@2618 -

.gitattributes

@@ -29,6 +29,7 @@ components/codetools/memcheck.pas svneol=native#text/pascal
 components/codetools/methodjumptool.pas svneol=native#text/pascal
 components/codetools/multikeywordlisttool.pas svneol=native#text/pascal
 components/codetools/pascalparsertool.pas svneol=native#text/pascal
+components/codetools/pascalreadertool.pas svneol=native#text/pascal
 components/codetools/resourcecodetool.pas svneol=native#text/pascal
 components/codetools/sourcechanger.pas svneol=native#text/pascal
 components/codetools/sourcelog.pas svneol=native#text/pascal
@@ -155,6 +156,8 @@ ide/aboutfrm.lrs svneol=native#text/pascal
 ide/aboutfrm.pas svneol=native#text/pascal
 ide/basedebugmanager.pas svneol=native#text/pascal
 ide/buildlazdialog.pas svneol=native#text/pascal
+ide/codeexplorer.lfm svneol=native#text/plain
+ide/codeexplorer.lrs svneol=native#text/pascal
 ide/codeexplorer.pas svneol=native#text/pascal
 ide/codetemplatedialog.pp svneol=native#text/pascal
 ide/codetoolsdefines.lrs svneol=native#text/pascal
@@ -482,6 +485,7 @@ languages/lazaruside.po svneol=native#text/plain
 lcl/actnlist.pas svneol=native#text/pascal
 lcl/allunits.pp svneol=native#text/pascal
 lcl/arrow.pp svneol=native#text/pascal
+lcl/avglvltree.pas svneol=native#text/pascal
 lcl/buttons.pp svneol=native#text/pascal
 lcl/calendar.pp svneol=native#text/pascal
 lcl/clipbrd.pp svneol=native#text/pascal

ide/codeexplorer.lfm

@@ -0,0 +1,68 @@
+object CodeExplorerView: TCodeExplorerView
+  CAPTION = 'CodeExplorerView'
+  CLIENTHEIGHT = 505
+  CLIENTWIDTH = 206
+  ONCLOSE = CodeExplorerViewCLOSE
+  ONCREATE = CodeExplorerViewCREATE
+  ONRESIZE = CodeExplorerViewRESIZE
+  HORZSCROLLBAR.PAGE = 207
+  VERTSCROLLBAR.PAGE = 506
+  LEFT = 378
+  HEIGHT = 505
+  TOP = 175
+  WIDTH = 206
+  object RefreshButton: TBUTTON
+    CAPTION = 'Refresh'
+    TABSTOP = True
+    TABORDER = 0
+    ONCLICK = RefreshButtonCLICK
+    HEIGHT = 25
+    WIDTH = 96
+  end
+  object OptionsButton: TBUTTON
+    ENABLED = False
+    CAPTION = 'Options'
+    TABSTOP = True
+    TABORDER = 1
+    LEFT = 110
+    HEIGHT = 25
+    WIDTH = 96
+  end
+  object CodeTreeview: TTREEVIEW
+    ALIGN = albottom
+    BACKGROUNDCOLOR = 16777215
+    BORDERWIDTH = 2
+    DEFAULTITEMHEIGHT = 17
+    DRAGCURSOR = 0
+    HIDESELECTION = False
+    IMAGES = Imagelist1
+    INDENT = 15
+    PARENTCTL3D = False
+    POPUPMENU = TreePopupmenu
+    RIGHTCLICKSELECT = True
+    SELECTIONCOLOR = -2147483635
+    TABORDER = 2
+    ONDELETION = CodeTreeviewDELETION
+    OPTIONS = [tvoautoitemheight, tvokeepcollapsednodes, tvorightclickselect, tvoshowbuttons, tvoshowlines, tvoshowroot, tvotooltips]
+    HEIGHT = 480
+    TOP = 25
+    WIDTH = 206
+  end
+  object Imagelist1: TIMAGELIST
+    left = 64
+    top = 32
+  end
+  object TreePopupmenu: TPOPUPMENU
+    left = 64
+    top = 72
+    object JumpToMenuitem: TMENUITEM
+      CAPTION = 'Jump to source'
+      ENABLED = False
+      ONCLICK = JumpToMenuitemCLICK
+    end
+    object RefreshMenuitem: TMENUITEM
+      CAPTION = 'Refresh'
+      ONCLICK = RefreshMenuitemCLICK
+    end
+  end
+end

ide/codeexplorer.lrs

@@ -0,0 +1,26 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TCodeExplorerView','FORMDATA',[
+  'TPF0'#17'TCodeExplorerView'#16'CodeExplorerView'#7'CAPTION'#6#16'CodeExplore'
+  +'rView'#12'CLIENTHEIGHT'#3#249#1#11'CLIENTWIDTH'#3#206#0#7'ONCLOSE'#7#21'Cod'
+  +'eExplorerViewCLOSE'#8'ONCREATE'#7#22'CodeExplorerViewCREATE'#8'ONRESIZE'#7
+  +#22'CodeExplorerViewRESIZE'#18'HORZSCROLLBAR.PAGE'#3#207#0#18'VERTSCROLLBAR.'
+  +'PAGE'#3#250#1#4'LEFT'#3'z'#1#6'HEIGHT'#3#249#1#3'TOP'#3#175#0#5'WIDTH'#3#206
+  +#0#0#7'TBUTTON'#13'RefreshButton'#7'CAPTION'#6#7'Refresh'#7'TABSTOP'#9#8'TAB'
+  +'ORDER'#2#0#7'ONCLICK'#7#18'RefreshButtonCLICK'#6'HEIGHT'#2#25#5'WIDTH'#2'`'
+  +#0#0#7'TBUTTON'#13'OptionsButton'#7'ENABLED'#8#7'CAPTION'#6#7'Options'#7'TAB'
+  +'STOP'#9#8'TABORDER'#2#1#4'LEFT'#2'n'#6'HEIGHT'#2#25#5'WIDTH'#2'`'#0#0#9'TTR'
+  +'EEVIEW'#12'CodeTreeview'#5'ALIGN'#7#8'albottom'#15'BACKGROUNDCOLOR'#4#255
+  +#255#255#0#11'BORDERWIDTH'#2#2#17'DEFAULTITEMHEIGHT'#2#17#10'DRAGCURSOR'#2#0
+  +#13'HIDESELECTION'#8#6'IMAGES'#7#10'Imagelist1'#6'INDENT'#2#15#11'PARENTCTL3'
+  +'D'#8#9'POPUPMENU'#7#13'TreePopupmenu'#16'RIGHTCLICKSELECT'#9#14'SELECTIONCO'
+  +'LOR'#4#13#0#0#128#8'TABORDER'#2#2#10'ONDELETION'#7#20'CodeTreeviewDELETION'
+  +#7'OPTIONS'#11#17'tvoautoitemheight'#21'tvokeepcollapsednodes'#19'tvorightcl'
+  +'ickselect'#14'tvoshowbuttons'#12'tvoshowlines'#11'tvoshowroot'#11'tvotoolti'
+  +'ps'#0#6'HEIGHT'#3#224#1#3'TOP'#2#25#5'WIDTH'#3#206#0#0#0#10'TIMAGELIST'#10
+  +'Imagelist1'#4'left'#2'@'#3'top'#2' '#0#0#10'TPOPUPMENU'#13'TreePopupmenu'#4
+  +'left'#2'@'#3'top'#2'H'#0#9'TMENUITEM'#14'JumpToMenuitem'#7'CAPTION'#6#14'Ju'
+  +'mp to source'#7'ENABLED'#8#7'ONCLICK'#7#19'JumpToMenuitemCLICK'#0#0#9'TMENU'
+  +'ITEM'#15'RefreshMenuitem'#7'CAPTION'#6#7'Refresh'#7'ONCLICK'#7#20'RefreshMe'
+  +'nuitemCLICK'#0#0#0#0
+]);

ide/codeexplorer.pas

@@ -1,190 +1,286 @@
-{
- /***************************************************************************
-                            codeexplorer.pas
-                            ----------------
-
- ***************************************************************************/
-
- ***************************************************************************
- *                                                                         *
- *   This source is free software; you can redistribute it and/or modify   *
- *   it under the terms of the GNU General Public License as published by  *
- *   the Free Software Foundation; either version 2 of the License, or     *
- *   (at your option) any later version.                                   *
- *                                                                         *
- *   This code is distributed in the hope that it will be useful, but      *
- *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
- *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
- *   General Public License for more details.                              *
- *                                                                         *
- *   A copy of the GNU General Public License is available on the World    *
- *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
- *   obtain it by writing to the Free Software Foundation,                 *
- *   Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.        *
- *                                                                         *
- ***************************************************************************
-
-  Author: Mattias Gaertner
-
-  Abstract:
-    TCodeExplorerView is the form of the IDE 'Code Explorer'.
-}
 unit CodeExplorer; 
 
 {$mode objfpc}{$H+}
 
 interface
 
-{$I ide.inc}
-
 uses
-  {$IFDEF IDE_MEM_CHECK}
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
-  MemCheck,
+  ComCtrls,
-  {$ENDIF}
+  CodeToolManager, CodeCache, CodeTree, PascalParserTool,
-  Classes, SysUtils, Controls, Forms, Dialogs, Buttons, ComCtrls, StdCtrls,
+  EnvironmentOpts, IDEOptionDefs, LazarusIDEStrConsts, InputHistory, IDEProcs,
-  CodeToolManager, CodeCache, EnvironmentOpts, LResources, IDEOptionDefs,
+  Menus;
-  LazarusIDEStrConsts, InputHistory, IDEProcs, Graphics, LCLType;
 
 type
+  TOnGetCodeTree =
+    procedure(Sender: TObject; var ACodeTool: TCodeTool) of object;
+  TOnJumpToCode = procedure(Sender: TObject; const Filename: string;
+    CleanPos: integer) of object;
+
+  TCodeExplorerViewFlag = (
+    cevRefreshNeeded,
+    cevRefresing
+    );
+  TCodeExplorerViewFlags = set of TCodeExplorerViewFlag;
+
   TCodeExplorerView = class(TForm)
-    NodeTypeImgList: TImageList;
+    Imagelist1: TIMAGELIST;
-    NodeTreeView: TTreeView;
+    JumpToMenuitem: TMENUITEM;
-    RefreshButton: TBitBtn;
+    RefreshMenuitem: TMENUITEM;
-    procedure CodeExplorerViewResize(Sender: TObject);
+    TreePopupmenu: TPOPUPMENU;
-    procedure NodeTreeViewAdvancedCustomDrawItem(Sender: TCustomTreeView;
+    RefreshButton: TBUTTON;
-          Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
+    OptionsButton: TBUTTON;
-          var PaintImages, DefaultDraw: Boolean);
+    CodeTreeview: TTREEVIEW;
-    procedure NodeTreeViewCollapsing(Sender: TObject; Node: TTreeNode;
+    procedure CodeExplorerViewCLOSE(Sender: TObject; var Action: TCloseAction);
-          var AllowCollapse: Boolean);
+    procedure CodeExplorerViewCREATE(Sender: TObject);
-    procedure NodeTreeViewExpanding(Sender: TObject; Node: TTreeNode;
+    procedure CodeExplorerViewRESIZE(Sender: TObject);
-          var AllowExpansion: Boolean);
+    procedure CodeTreeviewDELETION(Sender: TObject; Node: TTreeNode);
-    procedure RefreshButtonClick(Sender: TObject);
+    procedure JumpToMenuitemCLICK(Sender: TObject);
+    procedure RefreshButtonCLICK(Sender: TObject);
+    procedure RefreshMenuitemCLICK(Sender: TObject);
   private
+    FMainFilename: string;
+    FFlags: TCodeExplorerViewFlags;
+    FOnGetCodeTree: TOnGetCodeTree;
+    FOnJumpToCode: TOnJumpToCode;
+    FUpdateCount: integer;
+    function GetNodeDescription(ACodeTool: TCodeTool;
+                                CodeNode: TCodeTreeNode): string;
+    procedure CreateNodes(ACodeTool: TCodeTool; CodeNode: TCodeTreeNode;
+           ParentViewNode, InFrontViewNode: TTreeNode; CreateSiblings: boolean);
   public
-    constructor Create(TheOwner: TComponent); override;
+    procedure BeginUpdate;
-    destructor Destroy; override;
+    procedure EndUpdate;
-    procedure DoRefresh;
+    procedure Refresh;
+    procedure JumpToSelection;
+    property OnGetCodeTree: TOnGetCodeTree read FOnGetCodeTree
+                                           write FOnGetCodeTree;
+    property OnJumpToCode: TOnJumpToCode read FOnJumpToCode write FOnJumpToCode;
+    property MainFilename: string read FMainFilename;
   end;
 
 var
   CodeExplorerView: TCodeExplorerView;
 
-
 implementation
 
+type
+  TViewNodeData = class
+  public
+    Desc: TCodeTreeNodeDesc;
+    SubDesc: TCodeTreeNodeSubDesc;
+    StartPos, EndPos: integer;
+    constructor Create(CodeNode: TCodeTreeNode);
+  end;
+
+{ TViewNodeData }
+
+constructor TViewNodeData.Create(CodeNode: TCodeTreeNode);
+begin
+  Desc:=CodeNode.Desc;
+  SubDesc:=CodeNode.SubDesc;
+  StartPos:=CodeNode.StartPos;
+  EndPos:=CodeNode.EndPos;
+end;
 
 { TCodeExplorerView }
 
-procedure TCodeExplorerView.CodeExplorerViewResize(Sender: TObject);
+procedure TCodeExplorerView.CodeExplorerViewCREATE(Sender: TObject);
-begin
-  with RefreshButton do begin
-    SetBounds(0,0,70,Height);
-  end;
-
-  with NodeTreeView do begin
-    SetBounds(0,RefreshButton.Top+RefreshButton.Height,
-              Self.ClientWidth,Self.ClientHeight-Top);
-  end;
-end;
-
-procedure TCodeExplorerView.NodeTreeViewAdvancedCustomDrawItem(
-  Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
-  Stage: TCustomDrawStage; var PaintImages, DefaultDraw: Boolean);
-begin
-
-end;
-
-procedure TCodeExplorerView.NodeTreeViewCollapsing(Sender: TObject;
-  Node: TTreeNode; var AllowCollapse: Boolean);
-begin
-
-end;
-
-procedure TCodeExplorerView.NodeTreeViewExpanding(Sender: TObject;
-  Node: TTreeNode; var AllowExpansion: Boolean);
-begin
-
-end;
-
-procedure TCodeExplorerView.RefreshButtonClick(Sender: TObject);
-begin
-  DoRefresh;
-end;
-
-constructor TCodeExplorerView.Create(TheOwner: TComponent);
 
   procedure AddResImg(ImgList: TImageList; const ResName: string);
   var Pixmap: TPixmap;
   begin
     Pixmap:=TPixmap.Create;
     if LazarusResources.Find(ResName)=nil then
-      writeln('TCodeExplorerView.Create: ',
+      writeln('TCodeExplorerView.CodeExplorerViewCREATE: ',
         ' WARNING: icon not found: "',ResName,'"');
     Pixmap.LoadFromLazarusResource(ResName);
     ImgList.Add(Pixmap,nil)
   end;
 
+begin
+  Name:=NonModalIDEWindowNames[nmiwCodeExplorerName];
+  Caption := lisMenuViewCodeExplorer;
+  EnvironmentOptions.IDEWindowLayoutList.Apply(Self,Name);
+  
+  RefreshButton.Caption:=dlgUnitDepRefresh;
+  OptionsButton.Caption:=dlgFROpts;
+  
+  AddResImg(Imagelist1,'srctype_unknown_22x22');
+end;
+
+procedure TCodeExplorerView.CodeExplorerViewRESIZE(Sender: TObject);
 var
-  ALayout: TIDEWindowLayout;
+  y: Integer;
 begin
-  inherited Create(TheOwner);
+  RefreshButton.Width:=ClientWidth div 2;
-  if LazarusResources.Find(ClassName)=nil then begin
+  with OptionsButton do
-    Name:=DefaultCodeExplorerName;
+    SetBounds(RefreshButton.Width,Top,
-    Caption := lisCodeExplorer;
+              Parent.ClientWidth-RefreshButton.Width,Height);
-    ALayout:=EnvironmentOptions.IDEWindowLayoutList.ItemByFormID(Name);
+  y:=RefreshButton.Top+RefreshButton.Height;
-    ALayout.Form:=TForm(Self);
+  with CodeTreeview do
-    ALayout.Apply;
+    SetBounds(0,y,Parent.ClientWidth,Parent.ClientHeight-y);
+end;
 
-    NodeTypeImgList:=TImageList.Create(Self);
+procedure TCodeExplorerView.CodeTreeviewDELETION(Sender: TObject;
-    with NodeTypeImgList do begin
+  Node: TTreeNode);
-      Name:='NodeTypeImgList';
+begin
-      Width:=22;
+  if Node.Data<>nil then
-      Height:=22;
+    TViewNodeData(Node.Data).Free;
-      AddResImg(SrcTypeImageList,'nodetype_unknown_22x22');            // 0
+end;
-    end;
 
-    RefreshButton:=TBitBtn.Create(Self);
+procedure TCodeExplorerView.CodeExplorerViewCLOSE(Sender: TObject;
-    with RefreshButton do begin
+  var Action: TCloseAction);
-      Name:='RefreshButton';
+begin
-      Parent:=Self;
+  EnvironmentOptions.IDEWindowLayoutList.ItemByForm(Self).GetCurrentPosition;
-      Left:=0;
+end;
-      Top:=0;
-      Width:=70;
-      Caption:='Refresh';
-      OnClick:=@RefreshButtonClick;
-    end;
 
-    NodeTreeView:=TTreeView.Create(Self);
+procedure TCodeExplorerView.JumpToMenuitemCLICK(Sender: TObject);
-    with NodeTreeView do begin
+begin
-      Name:='NodeTreeView';
+  JumpToSelection;
-      Parent:=Self;
+end;
-      Left:=0;
-      Top:=RefreshButton.Top+RefreshButton.Height;
-      Width:=Self.ClientWidth;
-      Height:=Self.ClientHeight-Top;
-      OnExpanding:=@NodeTreeViewExpanding;
-      OnCollapsing:=@NodeTreeViewCollapsing;
-      Images:=NodeTypeImageList;
-      OnAdvancedCustomDrawItem:=@NodeTreeViewAdvancedCustomDrawItem;
-    end;
 
-    OnResize:=@CodeExplorerViewResize;
+procedure TCodeExplorerView.RefreshButtonCLICK(Sender: TObject);
+begin
+  Refresh;
+end;
+
+procedure TCodeExplorerView.RefreshMenuitemCLICK(Sender: TObject);
+begin
+  Refresh;
+end;
+
+function TCodeExplorerView.GetNodeDescription(ACodeTool: TCodeTool;
+  CodeNode: TCodeTreeNode): string;
+begin
+  case CodeNode.Desc of
+  
+  ctnUnit, ctnProgram, ctnLibrary, ctnPackage:
+    Result:=CodeNode.DescAsString+' '+ACodeTool.ExtractSourceName;
+
+  ctnTypeDefinition,ctnVarDefinition,ctnConstDefinition:
+    Result:=ACodeTool.ExtractIdentifier(CodeNode.StartPos);
+
+  ctnClass:
+    Result:='('+ACodeTool.ExtractClassInheritance(CodeNode,[])+')';
+            
+  ctnEnumIdentifier:
+    Result:=ACodeTool.ExtractIdentifier(CodeNode.StartPos);
+    
+  ctnProcedure:
+    Result:=ACodeTool.ExtractProcHead(CodeNode,
+                  [phpWithStart,phpWithVarModifiers,
+                   phpWithParameterNames,phpWithDefaultValues,phpWithResultType,
+                   phpWithOfObject,phpWithCallingSpecs]);
+                   
+  ctnProperty:
+    Result:='property '+ACodeTool.ExtractPropName(CodeNode,false);
+
+  else
+    Result:=CodeNode.DescAsString;
   end;
 end;
 
-destructor TCodeExplorerView.Destroy;
+procedure TCodeExplorerView.CreateNodes(ACodeTool: TCodeTool;
+  CodeNode: TCodeTreeNode;
+  ParentViewNode, InFrontViewNode: TTreeNode; CreateSiblings: boolean);
+var
+  NodeData: TViewNodeData;
+  NodeText: String;
+  ViewNode: TTreeNode;
+  NodeImageIndex: Integer;
 begin
-  inherited Destroy;
+  if CodeNode=nil then exit;
+  NodeData:=TViewNodeData.Create(CodeNode);
+  NodeText:=GetNodeDescription(ACodeTool,CodeNode);
+  NodeImageIndex:=0;
+  if InFrontViewNode<>nil then
+    ViewNode:=CodeTreeview.Items.InsertObjectBehind(
+                                              InFrontViewNode,NodeText,NodeData)
+  else if ParentViewNode<>nil then
+    ViewNode:=CodeTreeview.Items.AddChildObject(
+                                               ParentViewNode,NodeText,NodeData)
+  else
+    ViewNode:=CodeTreeview.Items.AddObject(nil,NodeText,NodeData);
+  ViewNode.ImageIndex:=NodeImageIndex;
+  ViewNode.SelectedIndex:=NodeImageIndex;
+  CreateNodes(ACodeTool,CodeNode.FirstChild,ViewNode,nil,true);
+  if CreateSiblings then begin
+    CreateNodes(ACodeTool,CodeNode.NextBrother,ParentViewNode,ViewNode,true);
+  end;
 end;
 
-procedure TCodeExplorerView.DoRefresh;
+procedure TCodeExplorerView.BeginUpdate;
 begin
+  inc(FUpdateCount);
+end;
 
+procedure TCodeExplorerView.EndUpdate;
+begin
+  if FUpdateCount<=0 then
+    RaiseException('TCodeExplorerView.EndUpdate');
+  dec(FUpdateCount);
+  if FUpdateCount=0 then begin
+    if cevRefreshNeeded in FFlags then Refresh;
+  end;
+end;
+
+procedure TCodeExplorerView.Refresh;
+var
+  OldExpanded: TTreeNodeExpandedState;
+  ACodeTool: TCodeTool;
+begin
+  if FUpdateCount>0 then begin
+    Include(FFlags,cevRefreshNeeded);
+    exit;
+  end;
+  Exclude(FFlags,cevRefreshNeeded);
+  
+  Include(FFlags,cevRefresing);
+
+  // get the codetool with the updated codetree
+  ACodeTool:=nil;
+  if Assigned(OnGetCodeTree) then
+    OnGetCodeTree(Self,ACodeTool);
+
+  // start updating the CodeTreeView
+  CodeTreeview.BeginUpdate;
+  OldExpanded:=TTreeNodeExpandedState.Create(CodeTreeView);
+
+  if (ACodeTool=nil) or (ACodeTool.Tree=nil) or (ACodeTool.Tree.Root=nil) then
+  begin
+    CodeTreeview.Items.Clear;
+    FMainFilename:='';
+  end else begin
+    FMainFilename:=ACodeTool.MainFilename;
+    CodeTreeview.Items.Clear;
+    CreateNodes(ACodeTool,ACodeTool.Tree.Root,nil,nil,true);
+  end;
+
+  // restore old expanded state
+  OldExpanded.Apply(CodeTreeView);
+  OldExpanded.Free;
+  CodeTreeview.EndUpdate;
+  
+  Exclude(FFlags,cevRefresing);
+end;
+
+procedure TCodeExplorerView.JumpToSelection;
+var
+  CurItem: TTreeNode;
+  CurNode: TViewNodeData;
+begin
+  CurItem:=CodeTreeview.Selected;
+  if CurItem=nil then exit;
+  CurNode:=TViewNodeData(CurItem.Data);
+
+  if Assigned(OnJumpToCode) then
+    OnJumpToCode(Self,MainFilename,CurNode.StartPos);
 end;
 
 initialization
+  {$I codeexplorer.lrs}
   CodeExplorerView:=nil;
 
-
 end.
 

lcl/include/wincontrol.inc

@@ -87,6 +87,8 @@ var
     NewLeft, NewTop, NewWidth, NewHeight: Integer;
     ParentBaseClientSize: TPoint;
     CurBaseBounds: TRect;
+    NewRight: Integer;
+    NewBottom: Integer;
   begin
     {$IFDEF CHECK_POSITION}
     with Control do
@@ -231,33 +233,31 @@ var
         is resized, an aligned control also resizes so that it continues to span
         the top, bottom, left, or right edge of the parent.
       }
-
+      NewRight:=NewLeft+NewWidth;
-      // alLeft, alRight do not fill horizontally
+      NewBottom:=NewTop+NewHeight;
-      if (AAlign in [alLeft, alRight]) then begin
+      if akLeft in AnchorAlign[AAlign] then begin
-        if NewWidth>ARect.Right-ARect.Left then
+        if not (akRight in Control.Anchors) then
-          NewWidth:=ARect.Right-ARect.Left;
+          dec(NewRight,NewLeft-ARect.Left);
-      end else
-        NewWidth := ARect.Right-ARect.Left;
-      if AAlign=alRight then begin
-        NewLeft:=ARect.Right-NewWidth;
-        if NewLeft<ARect.Left then
         NewLeft:=ARect.Left;
-      end else
+      end;
-        NewLeft:=ARect.Left;
+      if akTop in AnchorAlign[AAlign] then begin
-
+        if not (akBottom in Control.Anchors) then
-      // alTop, alBottom do not fill vertically
+          dec(NewBottom,NewTop-ARect.Top);
-      if (AAlign in [alTop, alBottom]) then begin
-        if NewHeight > ARect.Bottom-ARect.Top then
-          NewHeight := ARect.Bottom-ARect.Top;
-      end else
-        NewHeight := ARect.Bottom-ARect.Top;
-      if AAlign=alBottom then begin
-        NewTop:=ARect.Bottom-NewHeight;
-        if NewTop<ARect.Top then
-          NewTop:=ARect.Top;
-      end else
         NewTop:=ARect.Top;
       end;
+      if akRight in AnchorAlign[AAlign] then begin
+        if not (akLeft in Control.Anchors) then
+          inc(NewLeft,ARect.Right-NewRight);
+        NewRight:=ARect.Right;
+      end;
+      if akBottom in AnchorAlign[AAlign] then begin
+        if not (akTop in Control.Anchors) then
+          inc(NewTop,ARect.Bottom-NewBottom);
+        NewBottom:=ARect.Bottom;
+      end;
+      NewWidth:=Max(0,NewRight-NewLeft);
+      NewHeight:=Max(0,NewBottom-NewTop);
+    end;
         
     // set the new bounds
     if (Control.Left <> NewLeft) or (Control.Top <> NewTop)
@@ -2800,6 +2800,9 @@ end;
 { =============================================================================
 
   $Log$
+  Revision 1.139  2003/06/19 16:36:35  mattias
+  started codeexplorer
+
   Revision 1.138  2003/06/19 09:26:58  mattias
   fixed changing unitname during update