From 945205ad3cfdbbbde3325263b2e24dfb51de9ec7 Mon Sep 17 00:00:00 2001 From: mattias Date: Wed, 26 Jan 2005 15:45:08 +0000 Subject: [PATCH] implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks git-svn-id: trunk@6690 - --- components/codetools/extractproctool.pas | 44 ++- components/codetools/keywordfunclists.pas | 37 +++ components/codetools/pascalparsertool.pas | 14 + components/codetools/stdcodetools.pas | 4 +- ide/addtoprojectdlg.pas | 386 +++++++++++++++++----- ide/compileroptions.pp | 2 +- ide/lazarusidestrconsts.pas | 2 + ide/main.pp | 5 +- ide/projectinspector.pas | 15 +- lcl/controls.pp | 75 ++++- lcl/include/control.inc | 22 ++ lcl/include/wincontrol.inc | 6 +- packager/addtopackagedlg.pas | 22 +- packager/packagedefs.pas | 19 ++ 14 files changed, 512 insertions(+), 141 deletions(-) diff --git a/components/codetools/extractproctool.pas b/components/codetools/extractproctool.pas index 7ed7c8057b..aaf00f06e2 100644 --- a/components/codetools/extractproctool.pas +++ b/components/codetools/extractproctool.pas @@ -149,6 +149,7 @@ var CursorNode: TCodeTreeNode; BeginBlockNode: TCodeTreeNode; BlockCleanEnd: Integer; + BlockCleanStart: LongInt; ANode: TCodeTreeNode; ProcLvl: Integer; begin @@ -163,6 +164,7 @@ begin if CaretToCleanPos(EndPos,CleanEndPos)<>0 then exit; if CleanStartPos>=CleanEndPos then exit; {$IFDEF CTDebug} + debugln('TExtractProcTool.CheckExtractProc Selection="',copy(Src,CleanStartPos,CleanEndPos-CleanStartPos),'"'); DebugLn('TExtractProcTool.CheckExtractProc node check ..'); {$ENDIF} // check if in a Begin..End block @@ -178,24 +180,52 @@ begin // check every block in selection while true do begin ReadNextAtom; - if (CurPos.StartPos>SrcLen) or (CurPos.StartPos>CursorNode.EndPos) - or (CurPos.StartPos>CleanStartPos) then + if (CurPos.EndPos>CleanEndPos) or (CurPos.StartPos>SrcLen) + or (CurPos.StartPos>CursorNode.EndPos) then break; - if WordIsLogicalBlockStart.DoItUpperCase(UpperSrc, + //debugln('TExtractProcTool.CheckExtractProc A "',GetAtom,'"'); + if WordIsBlockStatementStart.DoItUpperCase(UpperSrc, CurPos.StartPos,CurPos.EndPos-CurPos.StartPos) then begin - if not ReadTilBlockEnd(true,false) then exit; + //debugln('TExtractProcTool.CheckExtractProc WordIsBlockStatementStart "',GetAtom,'"'); + BlockCleanStart:=CurPos.StartPos; + if not ReadTilBlockStatementEnd(true) then exit; BlockCleanEnd:=CurPos.EndPos; - if BlockCleanEndnil then begin - MessageDlg(lisProjAddUnitNameAlreadyExists, - Format(lisProjAddTheUnitNameAlreadyExistsInTheProject, ['"', - NewUnitName, '"', #13, '"', ConflictFile.Filename, '"']), - mtWarning,[mbCancel],0); - exit; - end; - // check if unitname already exists in selection - for j:=0 to NewFiles.Count-1 do begin - OtherFile:=TUnitInfo(NewFiles[j]); - if FilenameIsPascalUnit(OtherFile.Filename) then begin - OtherUnitName:=ExtractFileNameOnly(OtherFile.Filename); - if AnsiCompareText(OtherUnitName,NewUnitName)=0 then begin - MessageDlg(lisProjAddUnitNameAlreadyExists, - Format(lisProjAddTheUnitNameAlreadyExistsInTheSelection, ['"', - NewUnitName, '"', #13, '"', OtherFile.Filename, '"']), - mtWarning,[mbCancel],0); - exit; - end; - end; - end; + case CheckAddingFile(NewFiles, NewFilename) of + mrOk: ; + mrIgnore: continue; + else + exit; end; - NewFiles.Add(NewFile); + NewFiles.Add(NewFilename); end; // everything ok AddResult:=TAddToProjectResult.Create; AddResult.AddType:=a2pFiles; - AddResult.Files:=NewFiles; + AddResult.FileNames:=NewFiles; NewFiles:=nil; finally NewFiles.Free; @@ -357,56 +334,130 @@ begin SetBounds(x+NewDependButton.Width+10,y,80,Height); end; +procedure TAddToProjectDialog.FilesAddButtonClick(Sender: TObject); +var + i: Integer; + NewFilename: string; + NewFiles: TStringList; +begin + try + NewFiles:=TStringList.Create; + for i:=0 to FilesListView.Items.Count-1 do begin + NewFilename:=FilesListView.Items[i].Caption; + case CheckAddingFile(NewFiles, NewFilename) of + mrOk: ; + mrIgnore: continue; + else + exit; + end; + NewFiles.Add(NewFilename); + end; + // everything ok + AddResult:=TAddToProjectResult.Create; + AddResult.AddType:=a2pFiles; + AddResult.FileNames:=NewFiles; + NewFiles:=nil; + finally + NewFiles.Free; + end; + ModalResult:=mrOk; +end; + +procedure TAddToProjectDialog.FilesBrowseButtonClick(Sender: TObject); +var + OpenDialog: TOpenDialog; + AFilename: string; + i: Integer; + NewListItem: TListItem; + NewPgkFileType: TPkgFileType; + ADirectory: String; +begin + OpenDialog:=TOpenDialog.Create(nil); + try + InputHistories.ApplyFileDialogSettings(OpenDialog); + ADirectory:=TheProject.ProjectDirectory; + if not FilenameIsAbsolute(ADirectory) then ADirectory:=''; + if ADirectory<>'' then + OpenDialog.InitialDir:=ADirectory; + OpenDialog.Title:=lisOpenFile; + OpenDialog.Options:=OpenDialog.Options + +[ofFileMustExist,ofPathMustExist,ofAllowMultiSelect]; + if OpenDialog.Execute then begin + for i:=0 to OpenDialog.Files.Count-1 do begin + AFilename:=CleanAndExpandFilename(OpenDialog.Files[i]); + if FileExists(AFilename) then begin + if ADirectory<>'' then + AFilename:=CreateRelativePath(AFilename,ADirectory); + NewListItem:=FilesListView.Items.Add; + NewListItem.Caption:=AFilename; + NewPgkFileType:=FileNameToPkgFileType(AFilename); + NewListItem.SubItems.Add(GetPkgFileTypeLocalizedName(NewPgkFileType)); + end; + end; + end; + InputHistories.StoreFileDialogSettings(OpenDialog); + finally + OpenDialog.Free; + end; +end; + +procedure TAddToProjectDialog.FilesDeleteButtonClick(Sender: TObject); +var + i: Integer; +begin + for i:=FilesListView.Items.Count-1 downto 0 do + if FilesListView.Items[i].Selected then + FilesListView.Items.Delete(i); +end; + +procedure TAddToProjectDialog.FilesShortenButtonClick(Sender: TObject); +var + SwitchToAbsolute: Boolean; + i: Integer; + Filename: String; + ADirectory: String; +begin + if FilesListView.Items.Count=0 then exit; + if (TheProject=nil) + or (not FilenameIsAbsolute(TheProject.ProjectDirectory)) then exit; + ADirectory:=TheProject.ProjectDirectory; + SwitchToAbsolute:=not FilenameIsAbsolute(FilesListView.Items[0].Caption); + for i:=0 to FilesListView.Items.Count-1 do begin + Filename:=FilesListView.Items[i].Caption; + if SwitchToAbsolute then + Filename:=CreateAbsolutePath(Filename,ADirectory) + else + Filename:=CreateRelativePath(Filename,ADirectory); + FilesListView.Items[i].Caption:=Filename; + end; +end; + procedure TAddToProjectDialog.SetupComponents; begin NoteBook:=TNoteBook.Create(Self); with NoteBook do begin Name:='NoteBook'; Parent:=Self; - Pages.Add('Add File'); - AddFilePage:=Page[0]; + Pages.Add(lisProjAddEditorFile); + AddEditorFilePage:=Page[0]; Pages.Add(lisProjAddNewRequirement); NewDependPage:=Page[1]; + Pages.Add(lisProjAddFiles); + AddFilesPage:=Page[2]; PageIndex:=0; Align:=alClient; end; - AddFilePage.OnResize:=@AddFilePageResize; + AddEditorFilePage.OnResize:=@AddFilePageResize; NewDependPage.OnResize:=@NewDependPageResize; - AddFileLabel:=TLabel.Create(Self); - with AddFileLabel do begin - Name:='AddFileLabel'; - Parent:=AddFilePage; - Caption:=lisProjAddAddFileToProject; - end; - - AddFileListBox:=TListBox.Create(Self); - with AddFileListBox do begin - Name:='AddFileListBox'; - Parent:=AddFilePage; - MultiSelect:=true; - end; - - AddFileButton:=TButton.Create(Self); - with AddFileButton do begin - Name:='AddFileButton'; - Parent:=AddFilePage; - Caption:=lisLazBuildOk; - OnClick:=@AddFileButtonClick; - end; - - CancelAddFileButton:=TButton.Create(Self); - with CancelAddFileButton do begin - Name:='CancelAddFileButton'; - Parent:=AddFilePage; - Caption:=dlgCancel; - ModalResult:=mrCancel; - end; - - - // add required package + SetupAddEditorFilePage; + SetupAddRequirementPage; + SetupAddFilesPage; +end; +procedure TAddToProjectDialog.SetupAddRequirementPage; +begin DependPkgNameLabel:=TLabel.Create(Self); with DependPkgNameLabel do begin Name:='DependPkgNameLabel'; @@ -466,12 +517,169 @@ begin end; end; +procedure TAddToProjectDialog.SetupAddFilesPage; +var + CurColumn: TListColumn; +begin + FilesListView:=TListView.Create(Self); + with FilesListView do begin + Name:='FilesListView'; + Parent:=AddFilesPage; + MultiSelect:=true; + ViewStyle:=vsReport; + CurColumn:=Columns.Add; + CurColumn.Width:=200; + CurColumn.Caption:=lisA2PFilename2; + CurColumn:=Columns.Add; + CurColumn.Caption:=dlgEnvType; + Align:=alTop; + end; + + FilesBrowseButton:=TButton.Create(Self); + with FilesBrowseButton do begin + Name:='FilesBrowseButton'; + Parent:=AddFilesPage; + Caption:=lisPathEditBrowse; + AutoSize:=true; + Anchors:=[akLeft,akBottom]; + Left:=5; + AnchorParallel(akBottom,5,Parent); + OnClick:=@FilesBrowseButtonClick; + end; + FilesListView.AnchorToNeighbour(akBottom,5,FilesBrowseButton); + + FilesShortenButton:=TButton.Create(Self); + with FilesShortenButton do begin + Name:='FilesShortenButton'; + Parent:=AddFilesPage; + Caption:=lisA2PSwitchPaths; + AutoSize:=true; + AnchorToNeighbour(akLeft,5,FilesBrowseButton); + AnchorVerticalCenterTo(FilesBrowseButton); + OnClick:=@FilesShortenButtonClick; + end; + + FilesDeleteButton:=TButton.Create(Self); + with FilesDeleteButton do begin + Name:='FilesDeleteButton'; + Parent:=AddFilesPage; + Caption:=dlgEdDelete; + AutoSize:=true; + AnchorToNeighbour(akLeft,5,FilesShortenButton); + AnchorVerticalCenterTo(FilesBrowseButton); + OnClick:=@FilesDeleteButtonClick; + end; + + FilesAddButton:=TButton.Create(Self); + with FilesAddButton do begin + Name:='FilesAddButton'; + Parent:=AddFilesPage; + Caption:=lisA2PAddFilesToPackage; + AutoSize:=true; + AnchorToNeighbour(akLeft,5,FilesDeleteButton); + AnchorVerticalCenterTo(FilesBrowseButton); + OnClick:=@FilesAddButtonClick; + end; +end; + procedure TAddToProjectDialog.OnIteratePackages(APackageID: TLazPackageID); begin if (fPackages.Find(APackageID)=nil) then fPackages.Add(APackageID); end; +procedure TAddToProjectDialog.SetupAddEditorFilePage; +begin + AddFileLabel:=TLabel.Create(Self); + with AddFileLabel do begin + Name:='AddFileLabel'; + Parent:=AddEditorFilePage; + Caption:=lisProjAddAddFileToProject; + end; + + AddFileListBox:=TListBox.Create(Self); + with AddFileListBox do begin + Name:='AddFileListBox'; + Parent:=AddEditorFilePage; + MultiSelect:=true; + end; + + AddFileButton:=TButton.Create(Self); + with AddFileButton do begin + Name:='AddFileButton'; + Parent:=AddEditorFilePage; + Caption:=lisLazBuildOk; + OnClick:=@AddFileButtonClick; + end; + + CancelAddFileButton:=TButton.Create(Self); + with CancelAddFileButton do begin + Name:='CancelAddFileButton'; + Parent:=AddEditorFilePage; + Caption:=dlgCancel; + ModalResult:=mrCancel; + end; +end; + +function TAddToProjectDialog.CheckAddingFile(NewFiles: TStringList; + var NewFilename: string): TModalResult; +var + ConflictFile: TUnitInfo; + OtherUnitName: String; + OtherFile: string; + j: Integer; + NewFile: TUnitInfo; + NewUnitName: String; +begin + Result:=mrCancel; + // expand filename + if not FilenameIsAbsolute(NewFilename) then + NewFilename:= + TrimFilename(TheProject.ProjectDirectory+PathDelim+NewFilename); + // check if file is already part of project + NewFile:=TheProject.UnitInfoWithFilename(NewFilename); + if (NewFile<>nil) and NewFile.IsPartOfProject then begin + Result:=mrIgnore; + exit; + end; + // check unit name + if FilenameIsPascalUnit(NewFilename) then begin + // check unitname is valid pascal identifier + NewUnitName:=ExtractFileNameOnly(NewFilename); + if (NewUnitName='') or not (IsValidIdent(NewUnitName)) then begin + MessageDlg(lisProjAddInvalidPascalUnitName, + Format(lisProjAddTheUnitNameIsNotAValidPascalIdentifier, ['"', + NewUnitName, '"']), + mtWarning, [mbIgnore, mbCancel], 0); + exit; + end; + // check if unitname already exists in project + ConflictFile:=TheProject.UnitWithUnitname(NewUnitName); + if ConflictFile<>nil then begin + MessageDlg(lisProjAddUnitNameAlreadyExists, + Format(lisProjAddTheUnitNameAlreadyExistsInTheProject, ['"', + NewUnitName, '"', #13, '"', ConflictFile.Filename, '"']), + mtWarning, [mbCancel, mbIgnore], 0); + exit; + end; + // check if unitname already exists in selection + for j:=0 to NewFiles.Count-1 do begin + OtherFile:=NewFiles[j]; + if FilenameIsPascalUnit(OtherFile) then begin + OtherUnitName:=ExtractFileNameOnly(OtherFile); + if CompareText(OtherUnitName, NewUnitName)=0 then begin + MessageDlg(lisProjAddUnitNameAlreadyExists, + Format(lisProjAddTheUnitNameAlreadyExistsInTheSelection, ['"', + NewUnitName, '"', #13, '"', OtherFile, '"']), + mtWarning, [mbCancel], 0); + exit; + end; + end; + end; + end; + Result:=mrOk; +end; + constructor TAddToProjectDialog.Create(TheOwner: TComponent); begin inherited Create(TheOwner); @@ -540,7 +748,7 @@ end; destructor TAddToProjectResult.Destroy; begin - Files.Free; + FileNames.Free; inherited Destroy; end; diff --git a/ide/compileroptions.pp b/ide/compileroptions.pp index de2e887061..24c0917559 100644 --- a/ide/compileroptions.pp +++ b/ide/compileroptions.pp @@ -1783,7 +1783,7 @@ Processor specific options: // unit path CurUnitPath:=GetUnitPath(true); - debugln('TBaseCompilerOptions.MakeOptionsString A ',dbgsName(Self),' CurUnitPath="',CurUnitPath,'"'); + //debugln('TBaseCompilerOptions.MakeOptionsString A ',dbgsName(Self),' CurUnitPath="',CurUnitPath,'"'); // always add the current directory to the unit path, so that the compiler // checks for changed files in the directory CurUnitPath:=CurUnitPath+';.'; diff --git a/ide/lazarusidestrconsts.pas b/ide/lazarusidestrconsts.pas index 3c17693baa..11e77ae491 100644 --- a/ide/lazarusidestrconsts.pas +++ b/ide/lazarusidestrconsts.pas @@ -1907,6 +1907,8 @@ resourcestring lisProjAddTheUnitNameAlreadyExistsInTheSelection = 'The unit name %s%s%s ' +'already exists in the selection%swith file: %s%s%s.'; lisProjAddNewRequirement = 'New Requirement'; + lisProjAddFiles = 'Add files'; + lisProjAddEditorFile = 'Add editor files'; lisProjAddAddFileToProject = 'Add file to project:'; lisProjAddPackageName = 'Package Name:'; lisProjAddMinimumVersionOptional = 'Minimum Version (optional):'; diff --git a/ide/main.pp b/ide/main.pp index d76e8d9eab..1e5ee78873 100644 --- a/ide/main.pp +++ b/ide/main.pp @@ -10710,7 +10710,7 @@ begin ShortUnitName:=AnUnitInfo.UnitName; if (ShortUnitName<>'') then begin Dummy:=CodeToolBoss.AddUnitToMainUsesSection( - Project1.MainUnitInfo.Source,ShortUnitName,''); + Project1.MainUnitInfo.Source,ShortUnitName,''); ApplyCodeToolChanges; if Dummy then begin Project1.MainUnitInfo.Modified:=true; @@ -11380,6 +11380,9 @@ end. { ============================================================================= $Log$ + Revision 1.839 2005/01/26 15:45:07 mattias + implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks + Revision 1.838 2005/01/25 01:14:19 mattias implemented automatic redirecting of package output directory and filestate cache diff --git a/ide/projectinspector.pas b/ide/projectinspector.pas index 5129f450fd..6388d8b047 100644 --- a/ide/projectinspector.pas +++ b/ide/projectinspector.pas @@ -216,8 +216,9 @@ end; procedure TProjectInspectorForm.AddBitBtnClick(Sender: TObject); var AddResult: TAddToProjectResult; - NewFile: TUnitInfo; i: Integer; + NewFilename: string; + NewFile: TUnitInfo; begin if ShowAddToProjectDlg(LazProject,AddResult)<>mrOk then exit; @@ -225,8 +226,16 @@ begin a2pFiles: begin BeginUpdate; - for i:=0 to AddResult.Files.Count-1 do begin - NewFile:=TUnitInfo(AddResult.Files[i]); + for i:=0 to AddResult.FileNames.Count-1 do begin + NewFilename:=AddResult.FileNames[i]; + NewFile:=LazProject.UnitInfoWithFilename(NewFilename); + if NewFile<>nil then begin + if NewFile.IsPartOfProject then continue; + end else begin + NewFile:=TUnitInfo.Create(nil); + NewFile.Filename:=NewFilename; + LazProject.AddFile(NewFile,false); + end; NewFile.IsPartOfProject:=true; if Assigned(OnAddUnitToProject) then begin if OnAddUnitToProject(Self,NewFile)<>mrOk then break; diff --git a/lcl/controls.pp b/lcl/controls.pp index c4d40628aa..7b6081920e 100644 --- a/lcl/controls.pp +++ b/lcl/controls.pp @@ -1120,6 +1120,8 @@ type function AutoSizeDelayed: boolean; virtual; procedure AnchorToNeighbour(Side: TAnchorKind; Space: integer; Sibling: TControl); + procedure AnchorParallel(Side: TAnchorKind; Space: integer; + Sibling: TControl); procedure AnchorHorizontalCenterTo(Sibling: TControl); procedure AnchorVerticalCenterTo(Sibling: TControl); procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); virtual; @@ -2660,7 +2662,7 @@ begin Position:=0; OwnerParent:=FOwner.Parent; if OwnerParent=nil then begin - // AnchorSide is only between siblings allowed + // AnchorSide is only between siblings or its direct parent allowed ReferenceControl:=nil; exit; end; @@ -2675,10 +2677,11 @@ begin ReferenceControl:=nil; exit; end; - - // check sibling - if (ReferenceControl.Parent<>OwnerParent) then begin - // not a sibling -> invalid AnchorSide + + // check if ReferenceControl is valid + if (ReferenceControl.Parent<>OwnerParent) + and (ReferenceControl<>OwnerParent) then begin + // not a sibling and not the parent -> invalid AnchorSide ReferenceControl:=nil; exit; end; @@ -2695,25 +2698,39 @@ begin asrTop: if Kind in [akLeft,akRight] then begin // anchor to left side of ReferenceControl - Position:=ReferenceControl.Left; + if ReferenceControl=OwnerParent then + Position:=0 + else + Position:=ReferenceControl.Left; if Kind=akLeft then begin // anchor left of ReferenceControl and left of Owner inc(Position,OwnerBorderSpacing); end else begin // anchor left of ReferenceControl and right of Owner - OwnerBorderSpacing:=Max(OwnerBorderSpacing, + if ReferenceControl=OwnerParent then + OwnerBorderSpacing:=Max(OwnerBorderSpacing, + OwnerParent.ChildSizing.LeftRightSpacing) + else + OwnerBorderSpacing:=Max(OwnerBorderSpacing, ReferenceControl.BorderSpacing.GetSpace(akLeft)); dec(Position,OwnerBorderSpacing); end; end else begin // anchor to top side of ReferenceControl - Position:=ReferenceControl.Top; + if ReferenceControl=OwnerParent then + Position:=0 + else + Position:=ReferenceControl.Top; if Kind=akTop then begin // anchor top of ReferenceControl and top of Owner inc(Position,OwnerBorderSpacing); end else begin // anchor top of ReferenceControl and bottom of Owner - OwnerBorderSpacing:=Max(OwnerBorderSpacing, + if ReferenceControl=OwnerParent then + OwnerBorderSpacing:=Max(OwnerBorderSpacing, + OwnerParent.ChildSizing.TopBottomSpacing) + else + OwnerBorderSpacing:=Max(OwnerBorderSpacing, ReferenceControl.BorderSpacing.GetSpace(akTop)); dec(Position,OwnerBorderSpacing); end; @@ -2722,10 +2739,17 @@ begin asrBottom: if Kind in [akLeft,akRight] then begin // anchor to right side of ReferenceControl - Position:=ReferenceControl.Left+ReferenceControl.Width; + if ReferenceControl=OwnerParent then + Position:=OwnerParent.ClientWidth + else + Position:=ReferenceControl.Left+ReferenceControl.Width; if Kind=akLeft then begin // anchor right of ReferenceControl and left of Owner - OwnerBorderSpacing:=Max(OwnerBorderSpacing, + if ReferenceControl=OwnerParent then + OwnerBorderSpacing:=Max(OwnerBorderSpacing, + OwnerParent.ChildSizing.LeftRightSpacing) + else + OwnerBorderSpacing:=Max(OwnerBorderSpacing, ReferenceControl.BorderSpacing.GetSpace(akRight)); inc(Position,OwnerBorderSpacing); end else begin @@ -2734,10 +2758,17 @@ begin end; end else begin // anchor to bottom side of ReferenceControl - Position:=ReferenceControl.Top+ReferenceControl.Height; + if ReferenceControl=OwnerParent then + Position:=OwnerParent.ClientHeight + else + Position:=ReferenceControl.Top+ReferenceControl.Height; if Kind=akTop then begin // anchor bottom of ReferenceControl and top of Owner - OwnerBorderSpacing:=Max(OwnerBorderSpacing, + if ReferenceControl=OwnerParent then + OwnerBorderSpacing:=Max(OwnerBorderSpacing, + OwnerParent.ChildSizing.TopBottomSpacing) + else + OwnerBorderSpacing:=Max(OwnerBorderSpacing, ReferenceControl.BorderSpacing.GetSpace(akBottom)); inc(Position,OwnerBorderSpacing); end else begin @@ -2749,14 +2780,20 @@ begin asrCenter: if Kind in [akLeft,akRight] then begin // center horizontally - Position:=ReferenceControl.Left+(ReferenceControl.Width div 2); + if ReferenceControl=OwnerParent then + Position:=OwnerParent.ClientWidth div 2 + else + Position:=ReferenceControl.Left+(ReferenceControl.Width div 2); if Kind=akLeft then dec(Position,FOwner.Width div 2) else inc(Position,FOwner.Width div 2); end else begin // center vertically - Position:=ReferenceControl.Top+(ReferenceControl.Height div 2); + if ReferenceControl=OwnerParent then + Position:=OwnerParent.ClientHeight div 2 + else + Position:=ReferenceControl.Top+(ReferenceControl.Height div 2); if Kind=akTop then dec(Position,FOwner.Height div 2) else @@ -2770,7 +2807,10 @@ begin exit; end; // ReferenceControl is not visible -> try next - NextReferenceSide:=ReferenceControl.AnchorSide[ + if ReferenceControl=OwnerParent then + NextReferenceSide:=nil + else + NextReferenceSide:=ReferenceControl.AnchorSide[ AnchorReferenceSide[Kind,ReferenceSide]]; if (NextReferenceSide=nil) then begin ReferenceControl:=nil; @@ -2855,6 +2895,9 @@ end. { ============================================================================= $Log$ + Revision 1.277 2005/01/26 15:45:08 mattias + implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks + Revision 1.276 2005/01/25 09:58:16 mattias fixed fpc 1.0.10 compilation diff --git a/lcl/include/control.inc b/lcl/include/control.inc index ae9c017f72..18690fae41 100644 --- a/lcl/include/control.inc +++ b/lcl/include/control.inc @@ -3259,6 +3259,25 @@ begin Anchors:=Anchors+[Side]; end; +procedure TControl.AnchorParallel(Side: TAnchorKind; Space: integer; + Sibling: TControl); +begin + case Side of + akLeft: BorderSpacing.Left:=Space; + akTop: BorderSpacing.Top:=Space; + akRight: BorderSpacing.Right:=Space; + akBottom: BorderSpacing.Bottom:=Space; + end; + case Side of + akLeft: AnchorSide[Side].Side:=asrLeft; + akTop: AnchorSide[Side].Side:=asrTop; + akRight: AnchorSide[Side].Side:=asrRight; + akBottom: AnchorSide[Side].Side:=asrBottom; + end; + AnchorSide[Side].Control:=Sibling; + Anchors:=Anchors+[Side]; +end; + {------------------------------------------------------------------------------ procedure TControl.AnchorHorizontalCenterTo(Sibling: TControl); @@ -3430,6 +3449,9 @@ end; { ============================================================================= $Log$ + Revision 1.242 2005/01/26 15:45:08 mattias + implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks + Revision 1.241 2005/01/24 12:23:11 mattias fixed TColorButton.Paint diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 66da6d5b77..d5b618db63 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -168,10 +168,11 @@ var end; Result:=DefaultPosition; CurAnchorSide:=Control.AnchorSide[Kind]; - //debugln('GetAnchorSidePosition Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',dbgs(CurAnchorSide.Control<>nil)); + //debugln('GetAnchorSidePosition A Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',DbgSName(CurAnchorSide.Control)); CurAnchorSide.GetSidePosition(ReferenceControl,ReferenceSide,Position); if ReferenceControl<>nil then Result:=Position; + //debugln('GetAnchorSidePosition B Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',dbgs(Result)); AnchorSideCacheValid[Kind]:=true; AnchorSideCache[Kind]:=Result; end; @@ -4386,6 +4387,9 @@ end; { ============================================================================= $Log$ + Revision 1.308 2005/01/26 15:45:08 mattias + implemented adding files from directory in project inspector, fixed extrac proc checking overlapping blocks + Revision 1.307 2005/01/25 09:58:16 mattias fixed fpc 1.0.10 compilation diff --git a/packager/addtopackagedlg.pas b/packager/addtopackagedlg.pas index 913788a23a..6525ad397d 100644 --- a/packager/addtopackagedlg.pas +++ b/packager/addtopackagedlg.pas @@ -184,7 +184,6 @@ type procedure AutoCompleteNewComponentUnitName; procedure UpdateAddUnitInfo; procedure UpdateAddFileInfo; - function FileNameToPkgFileType(const AFilename: string): TPkgFileType; function SwitchRelativeAbsoluteFilename(const Filename: string): string; public Params: TAddToPkgResult; @@ -872,7 +871,7 @@ begin OpenDialog.Options:=OpenDialog.Options +[ofFileMustExist,ofPathMustExist,ofAllowMultiSelect]; if OpenDialog.Execute then begin - for i:=0 to OpenDialog.Files.COunt-1 do begin + for i:=0 to OpenDialog.Files.Count-1 do begin AFilename:=CleanAndExpandFilename(OpenDialog.Files[i]); if FileExists(AFilename) then begin LazPackage.ShortenFilename(AFilename,true); @@ -1724,25 +1723,6 @@ begin AddFileTypeRadioGroup.ItemIndex:=i; end; -function TAddToPackageDlg.FileNameToPkgFileType(const AFilename: string - ): TPkgFileType; -begin - if CompareFileExt(AFilename,'.lfm',true)=0 then - Result:=pftLFM - else if CompareFileExt(AFilename,'.lrs',true)=0 then - Result:=pftLRS - else if CompareFileExt(AFilename,'.inc',true)=0 then - Result:=pftInclude - else if CompareFileExt(AFilename,'.pas',true)=0 then - Result:=pftUnit - else if CompareFileExt(AFilename,'.pp',true)=0 then - Result:=pftUnit - else if FileIsText(AFilename) then - Result:=pftText - else - Result:=pftBinary; -end; - function TAddToPackageDlg.SwitchRelativeAbsoluteFilename(const Filename: string ): string; begin diff --git a/packager/packagedefs.pas b/packager/packagedefs.pas index 8c2c6eced2..8906d49e92 100644 --- a/packager/packagedefs.pas +++ b/packager/packagedefs.pas @@ -807,6 +807,7 @@ function PkgFileTypeIdentToType(const s: string): TPkgFileType; function LazPackageTypeIdentToType(const s: string): TLazPackageType; function GetPkgFileTypeLocalizedName(FileType: TPkgFileType): string; function NameToAutoUpdatePolicy(const s: string): TPackageUpdatePolicy; +function FileNameToPkgFileType(const AFilename: string): TPkgFileType; procedure SortDependencyList(Dependencies: TList); procedure LoadPkgDependencyList(XMLConfig: TXMLConfig; const ThePath: string; @@ -872,6 +873,24 @@ begin Result:=pupAsNeeded; end; +function FileNameToPkgFileType(const AFilename: string): TPkgFileType; +begin + if CompareFileExt(AFilename,'.lfm',true)=0 then + Result:=pftLFM + else if CompareFileExt(AFilename,'.lrs',true)=0 then + Result:=pftLRS + else if CompareFileExt(AFilename,'.inc',true)=0 then + Result:=pftInclude + else if CompareFileExt(AFilename,'.pas',true)=0 then + Result:=pftUnit + else if CompareFileExt(AFilename,'.pp',true)=0 then + Result:=pftUnit + else if FileIsText(AFilename) then + Result:=pftText + else + Result:=pftBinary; +end; + procedure LoadPkgDependencyList(XMLConfig: TXMLConfig; const ThePath: string; var First: TPkgDependency; ListType: TPkgDependencyList; Owner: TObject; HoldPackages: boolean);