From a5cbacff2796be3aa87019e29d03115d08ba280e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 8 Sep 2015 21:43:02 +0000 Subject: [PATCH] fpspreadsheet: Add "replace" to search engine. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4316 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/visual/fpsctrls/main.pas | 2 + .../examples/visual/shared/ssearchform.lfm | 291 +++++++++++------- .../examples/visual/shared/ssearchform.pas | 256 +++++++++++---- components/fpspreadsheet/fpspreadsheet.pas | 35 ++- components/fpspreadsheet/fpssearch.pas | 195 +++++++++--- components/fpspreadsheet/fpstypes.pas | 13 + 6 files changed, 583 insertions(+), 209 deletions(-) diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index 166f88d6b..7b26c1647 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas @@ -500,6 +500,7 @@ begin SearchForm.OnFound := @SearchFound; SearchForm.OnClose := @SearchClose; SearchForm.SearchParams := DefaultSearchParams; + SearchForm.ReplaceParams := DefaultReplaceParams; SearchForm.Execute(WorkbookSource.Workbook); end; @@ -609,6 +610,7 @@ procedure TMainForm.SearchClose(Sender: TObject; var CloseAction: TCloseAction); begin Unused(CloseAction); DefaultSearchParams := TSearchForm(Sender).SearchParams; + DefaultReplaceParams := TSearchForm(Sender).ReplaceParams; end; procedure TMainForm.SearchFound(Sender: TObject; AFound: Boolean; diff --git a/components/fpspreadsheet/examples/visual/shared/ssearchform.lfm b/components/fpspreadsheet/examples/visual/shared/ssearchform.lfm index 4cb732b31..80c722b14 100644 --- a/components/fpspreadsheet/examples/visual/shared/ssearchform.lfm +++ b/components/fpspreadsheet/examples/visual/shared/ssearchform.lfm @@ -1,112 +1,39 @@ object SearchForm: TSearchForm Left = 238 - Height = 272 + Height = 341 Top = 157 - Width = 483 + Width = 487 BorderStyle = bsDialog Caption = 'Search' - ClientHeight = 272 - ClientWidth = 483 + ClientHeight = 341 + ClientWidth = 487 FormStyle = fsStayOnTop OnClose = FormClose OnCreate = FormCreate OnShow = FormShow LCLVersion = '1.5' - object LblSearchText: TLabel - Left = 14 - Height = 15 - Top = 18 - Width = 53 - Caption = 'Search for' - ParentColor = False - end - object CbSearchText: TComboBox - Left = 93 - Height = 23 - Top = 14 - Width = 374 - Anchors = [akTop, akLeft, akRight] - ItemHeight = 15 - TabOrder = 0 - end - object CgSearchOptions: TCheckGroup - Left = 16 - Height = 163 - Top = 53 - Width = 192 - AutoFill = True - Caption = 'Search options' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.TopBottomSpacing = 6 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize - ChildSizing.EnlargeVertical = crsHomogenousChildResize - ChildSizing.ShrinkHorizontal = crsScaleChilds - ChildSizing.ShrinkVertical = crsScaleChilds - ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 1 - ClientHeight = 143 - ClientWidth = 188 - Items.Strings = ( - 'Compare entire cell ' - 'Match case' - 'Regular expression' - 'Search along rows' - 'Continue at start/end' - ) - TabOrder = 1 - Data = { - 050000000202020202 - } - end - object RgSearchWithin: TRadioGroup - Left = 232 - Height = 67 - Top = 53 - Width = 232 - AutoFill = True - Caption = 'Search within' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize - ChildSizing.EnlargeVertical = crsHomogenousChildResize - ChildSizing.ShrinkHorizontal = crsScaleChilds - ChildSizing.ShrinkVertical = crsScaleChilds - ChildSizing.Layout = cclTopToBottomThenLeftToRight - ChildSizing.ControlsPerLine = 2 - ClientHeight = 47 - ClientWidth = 228 - ColumnLayout = clVerticalThenHorizontal - Columns = 2 - ItemIndex = 0 - Items.Strings = ( - 'workbook' - 'worksheet' - 'column' - 'row' - ) - TabOrder = 2 - end object ButtonPanel: TPanel Left = 0 Height = 38 - Top = 234 - Width = 483 + Top = 303 + Width = 487 Align = alBottom BevelOuter = bvNone ClientHeight = 38 - ClientWidth = 483 - TabOrder = 3 + ClientWidth = 487 + TabOrder = 0 object Bevel1: TBevel Left = 6 Height = 3 Top = 0 - Width = 471 + Width = 475 Align = alTop BorderSpacing.Left = 6 BorderSpacing.Right = 6 Shape = bsTopLine end object BtnSearchBack: TBitBtn - Left = 240 + Left = 244 Height = 25 Top = 7 Width = 75 @@ -148,12 +75,12 @@ object SearchForm: TSearchForm 0000000000000000000000000000000000000000000054545411555555405555 555A555555655555555A55555540545454110000000000000000 } - OnClick = SearchButtonClick + OnClick = ExecuteClick TabOrder = 0 Visible = False end object BtnClose: TBitBtn - Left = 400 + Left = 404 Height = 25 Top = 7 Width = 75 @@ -165,7 +92,7 @@ object SearchForm: TSearchForm TabOrder = 1 end object BtnSearch: TBitBtn - Left = 320 + Left = 324 Height = 25 Top = 7 Width = 75 @@ -208,32 +135,178 @@ object SearchForm: TSearchForm 0000000000000000000000000000000000000000000054545411555555405555 555A555555655555555A55555540545454110000000000000000 } - OnClick = SearchButtonClick + OnClick = ExecuteClick TabOrder = 2 end end - object RgSearchStart: TRadioGroup - Left = 232 - Height = 56 - Top = 160 - Width = 232 - AutoFill = True - Caption = 'Start search at' - ChildSizing.LeftRightSpacing = 6 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize - ChildSizing.EnlargeVertical = crsHomogenousChildResize - ChildSizing.ShrinkHorizontal = crsScaleChilds - ChildSizing.ShrinkVertical = crsScaleChilds - ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 2 - ClientHeight = 36 - ClientWidth = 228 - Columns = 2 - ItemIndex = 0 - Items.Strings = ( - 'active cell' - 'beginning/end' + object TabControl: TTabControl + Left = 8 + Height = 287 + Top = 8 + Width = 471 + OnChange = TabControlChange + OnChanging = TabControlChanging + TabIndex = 0 + Tabs.Strings = ( + 'Search' + 'Replace' ) - TabOrder = 4 + Align = alClient + BorderSpacing.Around = 8 + TabOrder = 1 + object SearchTextPanel: TPanel + Left = 2 + Height = 33 + Top = 23 + Width = 467 + Align = alTop + BevelOuter = bvNone + ClientHeight = 33 + ClientWidth = 467 + Color = clNone + ParentColor = False + TabOrder = 1 + object LblSearchText: TLabel + Left = 14 + Height = 15 + Top = 12 + Width = 53 + Caption = 'Search for' + ParentColor = False + end + object CbSearchText: TComboBox + Left = 104 + Height = 23 + Top = 8 + Width = 351 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 15 + TabOrder = 0 + end + end + object ReplaceTextPanel: TPanel + Left = 2 + Height = 33 + Top = 56 + Width = 467 + Align = alTop + BevelOuter = bvNone + ClientHeight = 33 + ClientWidth = 467 + Color = clNone + ParentColor = False + TabOrder = 2 + Visible = False + object LblSearchText1: TLabel + Left = 14 + Height = 15 + Top = 12 + Width = 67 + Caption = 'Replace with' + ParentColor = False + end + object CbReplaceText: TComboBox + Left = 104 + Height = 23 + Top = 8 + Width = 351 + Anchors = [akTop, akLeft, akRight] + ItemHeight = 15 + TabOrder = 0 + end + end + object SearchParamsPanel: TPanel + Left = 2 + Height = 196 + Top = 89 + Width = 467 + Align = alClient + BevelOuter = bvNone + ClientHeight = 196 + ClientWidth = 467 + Color = clNone + ParentColor = False + TabOrder = 3 + object CgOptions: TCheckGroup + Left = 16 + Height = 163 + Top = 16 + Width = 192 + AutoFill = True + Caption = 'Options' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 143 + ClientWidth = 188 + Items.Strings = ( + 'Compare entire cell ' + 'Match case' + 'Regular expression' + 'Search along rows' + 'Continue at start/end' + ) + TabOrder = 0 + Data = { + 050000000202020202 + } + end + object RgSearchWithin: TRadioGroup + Left = 232 + Height = 67 + Top = 16 + Width = 223 + AutoFill = True + Caption = 'Search within' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclTopToBottomThenLeftToRight + ChildSizing.ControlsPerLine = 2 + ClientHeight = 47 + ClientWidth = 219 + ColumnLayout = clVerticalThenHorizontal + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + 'workbook' + 'worksheet' + 'column' + 'row' + ) + TabOrder = 1 + end + object RgSearchStart: TRadioGroup + Left = 232 + Height = 56 + Top = 123 + Width = 223 + AutoFill = True + Caption = 'Start search at' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 2 + ClientHeight = 36 + ClientWidth = 219 + Columns = 2 + ItemIndex = 0 + Items.Strings = ( + 'active cell' + 'beginning/end' + ) + TabOrder = 2 + end + end end end diff --git a/components/fpspreadsheet/examples/visual/shared/ssearchform.pas b/components/fpspreadsheet/examples/visual/shared/ssearchform.pas index e4e1a1623..e73ccb52e 100644 --- a/components/fpspreadsheet/examples/visual/shared/ssearchform.pas +++ b/components/fpspreadsheet/examples/visual/shared/ssearchform.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, - StdCtrls, ExtCtrls, Buttons, fpsTypes, fpspreadsheet, fpsSearch; + StdCtrls, ExtCtrls, Buttons, ComCtrls, fpsTypes, fpspreadsheet, fpsSearch; type TsSearchEvent = procedure (Sender: TObject; AFound: Boolean; @@ -20,29 +20,46 @@ type BtnClose: TBitBtn; BtnSearch: TBitBtn; CbSearchText: TComboBox; - CgSearchOptions: TCheckGroup; + CbReplaceText: TComboBox; + CgOptions: TCheckGroup; LblSearchText: TLabel; ButtonPanel: TPanel; + LblSearchText1: TLabel; + SearchParamsPanel: TPanel; + SearchTextPanel: TPanel; RgSearchStart: TRadioGroup; RgSearchWithin: TRadioGroup; + ReplaceTextPanel: TPanel; + TabControl: TTabControl; procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); - procedure SearchButtonClick(Sender: TObject); + procedure ExecuteClick(Sender: TObject); + procedure TabControlChange(Sender: TObject); + procedure TabControlChanging(Sender: TObject; var AllowChange: Boolean); private { private declarations } FSearchEngine: TsSearchEngine; FWorkbook: TsWorkbook; FFoundWorksheet: TsWorksheet; FFoundRow, FFoundCol: Cardinal; + FSearchParams: TsSearchParams; + FReplaceParams: TsReplaceParams; FOnFound: TsSearchEvent; - function GetParams: TsSearchParams; - procedure SetParams(const AValue: TsSearchParams); + function GetReplaceParams: TsReplaceParams; + function GetSearchParams: TsSearchParams; + procedure SetReplaceParams(const AValue: TsReplaceParams); + procedure SetSearchParams(const AValue: TsSearchParams); + protected + procedure ConfirmReplacementHandler(Sender: TObject; AWorksheet: TsWorksheet; + ARow, ACol: Cardinal; const ASearchText, AReplaceText: String; var Allow: Boolean); + procedure PopulateOptions; public { public declarations } procedure Execute(AWorkbook: TsWorkbook); property Workbook: TsWorkbook read FWorkbook; - property SearchParams: TsSearchParams read GetParams write SetParams; + property SearchParams: TsSearchParams read GetSearchParams write SetSearchParams; + property ReplaceParams: TsReplaceParams read GetReplaceParams write SetReplaceParams; property OnFound: TsSearchEvent read FOnFound write FOnFound; end; @@ -54,6 +71,10 @@ var Options: []; Within: swWorksheet ); + DefaultReplaceParams: TsReplaceParams = ( + ReplaceText: ''; + Options: [roConfirm] + ); implementation @@ -66,21 +87,108 @@ uses const MAX_SEARCH_ITEMS = 10; + // Search & replace COMPARE_ENTIRE_CELL = 0; MATCH_CASE = 1; REGULAR_EXPRESSION = 2; SEARCH_ALONG_ROWS = 3; CONTINUE_AT_START_END = 4; + // Replace only + REPLACE_ENTIRE_CELL = 5; + REPLACE_ALL = 6; + CONFIRM_REPLACEMENT = 7; + BASE_HEIGHT = 340; // Design height of SearchForm + + SEARCH_TAB = 0; + REPLACE_TAB = 1; { TSearchForms } +procedure TSearchForm.ConfirmReplacementHandler(Sender: TObject; + AWorksheet: TsWorksheet; ARow, ACol: Cardinal; + const ASearchText, AReplaceText: String; var Allow: Boolean); +begin + Unused(AWorksheet, ARow, ACol); + Unused(ASearchText, AReplaceText); + Allow := MessageDlg('Replace?', mtConfirmation, [mbYes, mbNo], 0) = mrYes; +end; + procedure TSearchForm.Execute(AWorkbook: TsWorkbook); begin FWorkbook := AWorkbook; Show; end; +procedure TSearchForm.ExecuteClick(Sender: TObject); +var + sp: TsSearchParams; + rp: TsReplaceParams; + found: Boolean; + crs: TCursor; +begin + sp := GetSearchParams; + if sp.SearchText = '' then + exit; + + if TabControl.TabIndex = REPLACE_TAB then + rp := GetReplaceParams; + + if CbSearchText.Items.IndexOf(sp.SearchText) = -1 then + begin + CbSearchText.Items.Insert(0, sp.SearchText); + while CbSearchText.Items.Count > MAX_SEARCH_ITEMS do + CbSearchText.Items.Delete(CbSearchText.Items.Count-1); + end; + + if (TabControl.TabIndex = REPLACE_TAB) and + (CbReplaceText.Items.IndexOf(rp.ReplaceText) = -1) then + begin + CbReplaceText.items.Insert(0, rp.ReplaceText); + while CbReplaceText.Items.Count > MAX_SEARCH_ITEMS do + CbReplaceText.Items.Delete(CbReplaceText.Items.Count-1); + end; + + crs := Screen.Cursor; + try + Screen.Cursor := crHourglass; + if FSearchEngine = nil then + begin + FSearchEngine := TsSearchEngine.Create(FWorkbook); + FSearchEngine.OnConfirmReplacement := @ConfirmReplacementHandler; + if (soBackward in sp.Options) then + Include(sp.Options, soBackward) else + Exclude(sp.Options, soBackward); + case Tabcontrol.TabIndex of + 0: found := FSearchEngine.FindFirst(sp, FFoundWorksheet, FFoundRow, FFoundCol); + 1: found := FSearchEngine.ReplaceFirst(sp, rp, FFoundWorksheet, FFoundRow, FFoundCol); + end; + end else + begin + if (Sender = BtnSearchBack) then + Include(sp.Options, soBackward) else + Exclude(sp.Options, soBackward); + // User may select a different worksheet/different cell to continue search! + FFoundWorksheet := FWorkbook.ActiveWorksheet; + FFoundRow := FFoundWorksheet.ActiveCellRow; + FFoundCol := FFoundWorksheet.ActiveCellCol; + case TabControl.TabIndex of + 0: found := FSearchEngine.FindNext(sp, FFoundWorksheet, FFoundRow, FFoundCol); + 1: found := FSearchEngine.ReplaceNext(sp, rp, FFoundWorksheet, FFoundRow, FFoundCol); + end; + end; + + finally + Screen.Cursor := crs; + end; + + if Assigned(FOnFound) then + FOnFound(self, found, FFoundWorksheet, FFoundRow, FFoundCol); + + BtnSearchBack.Visible := true; + BtnSearch.Caption := 'Next'; +end; + procedure TSearchForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); var P: TPoint; @@ -97,6 +205,7 @@ end; procedure TSearchForm.FormCreate(Sender: TObject); begin Position := poMainFormCenter; + PopulateOptions; end; procedure TSearchForm.FormShow(Sender: TObject); @@ -109,78 +218,115 @@ begin FFoundWorksheet := nil; end; -function TSearchForm.GetParams: TsSearchParams; +function TSearchForm.GetReplaceParams: TsReplaceParams; +begin + if TabControl.TabIndex = 0 then + Result := FReplaceParams + else + begin + Result.ReplaceText := CbReplaceText.Text; + Result.Options := []; + if CgOptions.Checked[REPLACE_ENTIRE_CELL] then + Include(Result.Options, roReplaceEntireCell); + if CgOptions.Checked[REPLACE_ALL] then + Include(Result.Options, roReplaceAll); + if CgOptions.Checked[CONFIRM_REPLACEMENT] then + Include(Result.Options, roConfirm); + FReplaceParams := Result; + end; +end; + +function TSearchForm.GetSearchParams: TsSearchParams; begin Result.SearchText := CbSearchText.Text; Result.Options := []; - if CgSearchOptions.Checked[COMPARE_ENTIRE_CELL] then + if CgOptions.Checked[COMPARE_ENTIRE_CELL] then Include(Result.Options, soCompareEntireCell); - if CgSearchOptions.Checked[MATCH_CASE] then + if CgOptions.Checked[MATCH_CASE] then Include(Result.Options, soMatchCase); - if CgSearchOptions.Checked[REGULAR_EXPRESSION] then + if CgOptions.Checked[REGULAR_EXPRESSION] then Include(Result.Options, soRegularExpr); - if CgSearchOptions.Checked[SEARCH_ALONG_ROWS] then + if CgOptions.Checked[SEARCH_ALONG_ROWS] then Include(Result.Options, soAlongRows); - if CgSearchOptions.Checked[CONTINUE_AT_START_END] then + if CgOptions.Checked[CONTINUE_AT_START_END] then Include(Result.Options, soWrapDocument); if RgSearchStart.ItemIndex = 1 then Include(Result.Options, soEntireDocument); Result.Within := TsSearchWithin(RgSearchWithin.ItemIndex); end; -procedure TSearchForm.SearchButtonClick(Sender: TObject); -var - params: TsSearchParams; - found: Boolean; +procedure TSearchForm.PopulateOptions; begin - params := GetParams; - if params.SearchText = '' then - exit; - - if CbSearchText.Items.IndexOf(params.SearchText) = -1 then + with CgOptions.Items do begin - CbSearchText.Items.Insert(0, params.SearchText); - while CbSearchText.Items.Count > MAX_SEARCH_ITEMS do - CbSearchText.Items.Delete(CbSearchText.Items.Count-1); + Clear; + Add('Compare entire cell'); + Add('Match case'); + Add('Regular expression'); + Add('Search along rows'); + Add('Continue at start/end'); + if TabControl.TabIndex = REPLACE_TAB then + begin + Add('Replace entire cell'); + Add('Replace all'); + Add('Confirm replacement'); + end; end; - - if FSearchEngine = nil then - begin - FSearchEngine := TsSearchEngine.Create(FWorkbook); - if (soBackward in params.Options) then - Include(params.Options, soBackward) else - Exclude(params.Options, soBackward); - found := FSearchEngine.FindFirst(params.SearchText, params, FFoundWorksheet, FFoundRow, FFoundCol); - end else - begin - if (Sender = BtnSearchBack) then - Include(params.Options, soBackward) else - Exclude(params.Options, soBackward); - // User may select a different worksheet/different cell to continue search! - FFoundWorksheet := FWorkbook.ActiveWorksheet; - FFoundRow := FFoundWorksheet.ActiveCellRow; - FFoundCol := FFoundWorksheet.ActiveCellCol; - found := FSearchEngine.FindNext(params.SearchText, params, FFoundWorksheet, FFoundRow, FFoundCol); - end; - - if Assigned(FOnFound) then - FOnFound(self, found, FFoundWorksheet, FFoundRow, FFoundCol); - - BtnSearchBack.Visible := true; - BtnSearch.Caption := 'Next'; end; -procedure TSearchForm.SetParams(const AValue: TsSearchParams); +procedure TSearchForm.SetSearchParams(const AValue: TsSearchParams); begin CbSearchText.Text := Avalue.SearchText; - CgSearchOptions.Checked[COMPARE_ENTIRE_CELL] := (soCompareEntireCell in AValue.Options); - CgSearchOptions.Checked[MATCH_CASE] := (soMatchCase in AValue.Options); - CgSearchOptions.Checked[REGULAR_EXPRESSION] := (soRegularExpr in Avalue.Options); - CgSearchOptions.Checked[SEARCH_ALONG_ROWS] := (soAlongRows in AValue.Options); - CgSearchOptions.Checked[CONTINUE_AT_START_END] := (soWrapDocument in Avalue.Options); + CgOptions.Checked[COMPARE_ENTIRE_CELL] := (soCompareEntireCell in AValue.Options); + CgOptions.Checked[MATCH_CASE] := (soMatchCase in AValue.Options); + CgOptions.Checked[REGULAR_EXPRESSION] := (soRegularExpr in Avalue.Options); + CgOptions.Checked[SEARCH_ALONG_ROWS] := (soAlongRows in AValue.Options); + CgOptions.Checked[CONTINUE_AT_START_END] := (soWrapDocument in Avalue.Options); RgSearchWithin.ItemIndex := ord(AValue.Within); RgSearchStart.ItemIndex := ord(soEntireDocument in AValue.Options); end; +procedure TSearchForm.SetReplaceParams(const AValue: TsReplaceParams); +begin + FReplaceParams := AValue; + if TabControl.TabIndex = REPLACE_TAB then + begin + CbReplaceText.Text := AValue.ReplaceText; + CgOptions.Checked[REPLACE_ENTIRE_CELL] := (roReplaceEntireCell in AValue.Options); + CgOptions.Checked[REPLACE_ALL] := (roReplaceAll in AValue.Options); + CgOptions.Checked[CONFIRM_REPLACEMENT] := (roConfirm in AValue.Options); + end; +end; + +procedure TSearchForm.TabControlChange(Sender: TObject); +var + h, d: Integer; +begin + ReplaceTextPanel.Visible := (TabControl.TabIndex = REPLACE_TAB); + PopulateOptions; + SetSearchParams(FSearchParams); + SetReplaceParams(FReplaceParams); + h := RgSearchStart.Top + RgSearchStart.Height - CgOptions.Top; + if TabControl.TabIndex = 0 then + begin + CgOptions.Height := h; + Height := BASE_HEIGHT - ReplaceTextPanel.Height; + end else + begin + d := 3 * 16; + CgOptions.Height := h + d; + Height := BASE_HEIGHT + d; + end; +end; + +procedure TSearchForm.TabControlChanging(Sender: TObject; + var AllowChange: Boolean); +begin + AllowChange := true; + FSearchParams := GetSearchParams; + FReplaceParams := GetReplaceParams; +end; + + end. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 5244f599a..68d3f7b85 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -737,6 +737,9 @@ type out ARow, ACol: Cardinal): Boolean; *) { Utilities } + procedure DisableNotifications; + procedure EnableNotifications; + function NotificationsEnabled: Boolean; procedure UpdateCaches; { Error messages } @@ -1530,7 +1533,7 @@ begin CalcFormulas; end; - if Assigned(FOnChangeCell) then + if FWorkbook.NotificationsEnabled and Assigned(FOnChangeCell) then FOnChangeCell(Self, ARow, ACol); end; @@ -1543,7 +1546,7 @@ end; -------------------------------------------------------------------------------} procedure TsWorksheet.ChangedFont(ARow, ACol: Cardinal); begin - if FWorkbook.FReadWriteFlag = rwfRead then + if (FWorkbook.FReadWriteFlag = rwfRead) or not FWorkbook.NotificationsEnabled then exit; if Assigned(FOnChangeFont) then FOnChangeFont(Self, ARow, ACol); @@ -3521,6 +3524,9 @@ end; -------------------------------------------------------------------------------} procedure TsWorksheet.SelectCell(ARow, ACol: Cardinal); begin + if not FWorkbook.NotificationsEnabled then + exit; + FActiveCellRow := ARow; FActiveCellCol := ACol; if Assigned(FOnSelectCell) then @@ -6361,6 +6367,31 @@ begin Result := (FSearchEngine as TsSearchEngine).FindNext(AWorksheet, ARow, ACol); end; *) + +{@@ ---------------------------------------------------------------------------- + Helper method to disable notification of visual controls +-------------------------------------------------------------------------------} +procedure TsWorkbook.DisableNotifications; +begin + inc(FLockCount); +end; + +{@@ ---------------------------------------------------------------------------- + Helper method to enable notification of visual controls +-------------------------------------------------------------------------------} +procedure TsWorkbook.EnableNotifications; +begin + dec(FLockCount); +end; + +{@@ ---------------------------------------------------------------------------- + Helper method to determine whether visual controls are notified of changes +-------------------------------------------------------------------------------} +function TsWorkbook.NotificationsEnabled: Boolean; +begin + Result := (FLockCount = 0); +end; + {@@ ---------------------------------------------------------------------------- Helper method to update internal caching variables -------------------------------------------------------------------------------} diff --git a/components/fpspreadsheet/fpssearch.pas b/components/fpspreadsheet/fpssearch.pas index 96043b66d..4e6d49cc1 100644 --- a/components/fpspreadsheet/fpssearch.pas +++ b/components/fpspreadsheet/fpssearch.pas @@ -8,14 +8,21 @@ uses Classes, SysUtils, RegExpr, fpstypes, fpspreadsheet; type + TsConfirmReplacementEvent = procedure (Sender: TObject; AWorksheet: TsWorksheet; + ARow, ACol: Cardinal; const ASearchText, AReplaceText: String; + var Allow: Boolean) of object; + TsSearchEngine = class private FWorkbook: TsWorkbook; FSearchText: String; - FParams: TsSearchParams; + FSearchParams: TsSearchParams; + FReplaceParams: TsReplaceParams; FCurrSel: Integer; FRegEx: TRegExpr; + FOnConfirmReplacement: TsConfirmReplacementEvent; protected + function ExecReplace(AWorksheet: TsWorksheet; ARow, ACol: Cardinal): boolean; function ExecSearch(var AWorksheet: TsWorksheet; var ARow, ACol: Cardinal): Boolean; procedure GotoFirst(out AWorksheet: TsWorksheet; out ARow, ACol: Cardinal); @@ -34,10 +41,19 @@ type public constructor Create(AWorkbook: TsWorkbook); destructor Destroy; override; - function FindFirst(const ASearchText: String; const AParams: TsSearchParams; + function FindFirst(const ASearchParams: TsSearchParams; out AWorksheet: TsWorksheet; out ARow, ACol: Cardinal): Boolean; - function FindNext(const ASearchText: String; const AParams: TsSearchParams; + function FindNext(const ASearchParams: TsSearchParams; var AWorksheet: TsWorksheet; var ARow, ACol: Cardinal): Boolean; + function ReplaceFirst(const ASearchParams: TsSearchParams; + const AReplaceParams: TsReplaceParams; + out AWorksheet: TsWorksheet; out ARow, ACol: Cardinal): Boolean; + function ReplaceNext(const ASearchParams: TsSearchParams; + const AReplaceParams: TsReplaceParams; + var AWorksheet: TsWorksheet; var ARow, ACol: Cardinal): Boolean; + + property OnConfirmReplacement: TsConfirmReplacementEvent + read FOnConfirmReplacement write FOnConfirmReplacement; end; implementation @@ -57,6 +73,44 @@ begin inherited Destroy; end; +function TsSearchEngine.ExecReplace(AWorksheet: TsWorksheet; ARow, ACol: Cardinal) : Boolean; +var + res: Integer; + s: String; + allow: Boolean; + flags: TReplaceFlags; +begin + if roConfirm in FReplaceParams.Options then + begin + allow := false; + if Assigned(FOnConfirmReplacement) then + begin + FOnConfirmReplacement(self, AWorksheet, ARow, ACol, + FSearchParams.SearchText, FReplaceParams.ReplaceText, allow); + if not allow then + exit(false); + end else + raise Exception.Create('[TsSearchEngine.ExecReplace] OnConfirmReplacement handler needed.'); + end; + + if roReplaceEntireCell in FReplaceParams.Options then + AWorksheet.WriteCellValueAsString(ARow, ACol, FReplaceParams.ReplaceText) + else begin + s := AWorksheet.ReadAsText(ARow, ACol); + if soCompareEntireCell in FSearchParams.Options then + AWorksheet.WriteCellValueAsString(ARow, ACol, FReplaceParams.ReplaceText) + else + begin + flags := []; + if not (soMatchCase in FSearchParams.Options) then + Include(flags, rfIgnoreCase); + s := UTF8StringReplace(s, FSearchparams.SearchText, FReplaceParams.ReplaceText, flags); + AWorksheet.WritecellValueAsString(ARow, ACol, s); + // to do: RegEx to be added + end; + end; +end; + function TsSearchEngine.ExecSearch(var AWorksheet: TsWorksheet; var ARow, ACol: Cardinal): Boolean; var @@ -70,7 +124,7 @@ begin complete := false; while (not complete) and (not Matches(AWorksheet, ARow, ACol)) do begin - if soBackward in FParams.Options then + if soBackward in FSearchParams.Options then complete := not GotoPrev(AWorkSheet, ARow, ACol) else complete := not GotoNext(AWorkSheet, ARow, ACol); // Avoid infinite loop if search phrase does not exist in document. @@ -90,28 +144,26 @@ begin end; end; -function TsSearchEngine.FindFirst(const ASearchText: String; - const AParams: TsSearchParams; out AWorksheet: TsWorksheet; - out ARow, ACol: Cardinal): Boolean; +function TsSearchEngine.FindFirst(const ASearchParams: TsSearchParams; + out AWorksheet: TsWorksheet; out ARow, ACol: Cardinal): Boolean; begin - FParams := AParams; - PrepareSearchText(ASearchText); + FSearchParams := ASearchParams; + PrepareSearchText(FSearchParams.SearchText); - if soBackward in FParams.Options then + if soBackward in FSearchParams.Options then GotoLast(AWorksheet, ARow, ACol) else GotoFirst(AWorksheet, ARow, ACol); Result := ExecSearch(AWorksheet, ARow, ACol); end; -function TsSearchEngine.FindNext(const ASearchText: String; - const AParams: TsSearchParams; var AWorksheet: TsWorksheet; - var ARow, ACol: Cardinal): Boolean; +function TsSearchEngine.FindNext(const ASearchParams: TsSearchParams; + var AWorksheet: TsWorksheet; var ARow, ACol: Cardinal): Boolean; begin - FParams := AParams; - PrepareSearchText(ASearchText); + FSearchParams := ASearchParams; + PrepareSearchText(FSearchParams.SearchText); - if soBackward in FParams.Options then + if soBackward in FSearchParams.Options then GotoPrev(AWorksheet, ARow, ACol) else GotoNext(AWorksheet, ARow, ACol); @@ -121,9 +173,9 @@ end; procedure TsSearchEngine.GotoFirst(out AWorksheet: TsWorksheet; out ARow, ACol: Cardinal); begin - if soEntireDocument in FParams.Options then + if soEntireDocument in FSearchParams.Options then // Search entire document forward from start - case FParams.Within of + case FSearchParams.Within of swWorkbook : begin AWorksheet := FWorkbook.GetWorksheetByIndex(0); @@ -153,6 +205,7 @@ begin begin // Search starts at active cell AWorksheet := FWorkbook.ActiveWorksheet; + if AWorksheet = nil then AWorksheet := FWorkbook.GetFirstWorksheet; ARow := AWorksheet.ActiveCellRow; ACol := AWorksheet.ActiveCellCol; end; @@ -164,9 +217,9 @@ var cell: PCell; sel: TsCellRangeArray; begin - if soEntireDocument in FParams.Options then + if soEntireDocument in FSearchParams.Options then // Search entire document backward from end - case FParams.Within of + case FSearchParams.Within of swWorkbook : begin AWorksheet := FWorkbook.GetWorksheetByIndex(FWorkbook.GetWorksheetCount-1); @@ -212,7 +265,7 @@ begin if GotoNextInWorksheet(AWorksheet, ARow, ACol) then exit; - case FParams.Within of + case FSearchParams.Within of swWorkbook: begin // Need to go to next sheet @@ -225,7 +278,7 @@ begin exit; end; // Continue search with first worksheet - if (soWrapDocument in FParams.Options) then + if (soWrapDocument in FSearchParams.Options) then begin AWorksheet := FWorkbook.GetWorksheetByIndex(0); ARow := 0; @@ -235,21 +288,21 @@ begin end; swWorksheet: - if soWrapDocument in FParams.Options then begin + if soWrapDocument in FSearchParams.Options then begin ARow := 0; ACol := 0; exit; end; swColumn: - if soWrapDocument in FParams.Options then begin + if soWrapDocument in FSearchParams.Options then begin ARow := 0; ACol := AWorksheet.ActiveCellCol; exit; end; swRow: - if soWrapDocument in FParams.Options then begin + if soWrapDocument in FSearchParams.Options then begin ARow := AWorksheet.ActiveCellRow; ACol := 0; exit; @@ -264,12 +317,12 @@ function TsSearchEngine.GotoNextInWorksheet(AWorksheet: TsWorksheet; var ARow, ACol: Cardinal): Boolean; begin Result := true; - if (soAlongRows in FParams.Options) or (FParams.Within = swRow) then + if (soAlongRows in FSearchParams.Options) or (FSearchParams.Within = swRow) then begin inc(ACol); if ACol <= AWorksheet.GetLastColIndex then exit; - if (FParams.Within <> swRow) then + if (FSearchParams.Within <> swRow) then begin ACol := 0; inc(ARow); @@ -277,12 +330,12 @@ begin exit; end; end else - if not (soAlongRows in FParams.Options) or (FParams.Within = swColumn) then + if not (soAlongRows in FSearchParams.Options) or (FSearchParams.Within = swColumn) then begin inc(ARow); if ARow <= AWorksheet.GetLastRowIndex then exit; - if (FParams.Within <> swColumn) then + if (FSearchParams.Within <> swColumn) then begin ARow := 0; inc(ACol); @@ -305,7 +358,7 @@ begin if GotoPrevInWorksheet(AWorksheet, ARow, ACol) then exit; - case FParams.Within of + case FSearchParams.Within of swWorkbook: begin // Need to go to previous sheet @@ -317,7 +370,7 @@ begin ACol := AWorksheet.GetlastColIndex; exit; end; - if (soWrapDocument in FParams.Options) then + if (soWrapDocument in FSearchParams.Options) then begin AWorksheet := FWorkbook.GetWorksheetByIndex(FWorkbook.GetWorksheetCount-1); ARow := AWorksheet.GetLastRowIndex; @@ -327,7 +380,7 @@ begin end; swWorksheet: - if soWrapDocument in FParams.Options then + if soWrapDocument in FSearchParams.Options then begin ARow := AWorksheet.GetLastRowIndex; ACol := AWorksheet.GetLastColIndex; @@ -335,7 +388,7 @@ begin end; swColumn: - if soWrapDocument in FParams.Options then + if soWrapDocument in FSearchParams.Options then begin ARow := AWorksheet.GetLastRowIndex; ACol := AWorksheet.ActiveCellCol; @@ -343,7 +396,7 @@ begin end; swRow: - if soWrapDocument in FParams.Options then + if soWrapDocument in FSearchParams.Options then begin ARow := AWorksheet.ActiveCellRow; ACol := AWorksheet.GetLastColIndex; @@ -358,13 +411,13 @@ function TsSearchEngine.GotoPrevInWorksheet(AWorksheet: TsWorksheet; var ARow, ACol: Cardinal): Boolean; begin Result := true; - if (soAlongRows in FParams.Options) or (FParams.Within = swRow) then + if (soAlongRows in FSearchParams.Options) or (FSearchParams.Within = swRow) then begin if ACol > 0 then begin dec(ACol); exit; end; - if (FParams.Within <> swRow) then + if (FSearchParams.Within <> swRow) then begin ACol := AWorksheet.GetLastColIndex; if ARow > 0 then @@ -374,13 +427,13 @@ begin end; end; end else - if not (soAlongRows in FParams.Options) or (FParams.Within = swColumn) then + if not (soAlongRows in FSearchParams.Options) or (FSearchParams.Within = swColumn) then begin if ARow > 0 then begin dec(ARow); exit; end; - if (FParams.Within <> swColumn) then + if (FSearchParams.Within <> swColumn) then begin ARow := AWorksheet.GetlastRowIndex; if ACol > 0 then @@ -404,13 +457,13 @@ begin celltxt := AWorksheet.ReadAsText(cell) else celltxt := ''; - if soRegularExpr in FParams.Options then + if soRegularExpr in FSearchParams.Options then Result := FRegEx.Exec(celltxt) else begin - if not (soMatchCase in FParams.Options) then + if not (soMatchCase in FSearchParams.Options) then celltxt := UTF8Lowercase(celltxt); - if soCompareEntireCell in FParams.Options then + if soCompareEntireCell in FSearchParams.Options then exit(celltxt = FSearchText); if UTF8Pos(FSearchText, celltxt) > 0 then exit(true); @@ -420,16 +473,72 @@ end; procedure TsSearchEngine.PrepareSearchText(const ASearchText: String); begin - if soRegularExpr in FParams.Options then + if soRegularExpr in FSearchParams.Options then begin FreeAndNil(FRegEx); FRegEx := TRegExpr.Create; FRegEx.Expression := ASearchText end else - if (soMatchCase in FParams.Options) then + if (soMatchCase in FSearchParams.Options) then FSearchText := ASearchText else FSearchText := UTF8Lowercase(ASearchText); end; +function TsSearchEngine.ReplaceFirst(const ASearchParams: TsSearchParams; + const AReplaceParams: TsReplaceParams; out AWorksheet: TsWorksheet; + out ARow, ACol: Cardinal): Boolean; +var + r,c: Cardinal; + sheet: TsWorksheet; +begin + Result := FindFirst(ASearchParams, AWorksheet, ARow, ACol); + if Result then + begin + FReplaceParams := AReplaceParams; + Result := ExecReplace(AWorksheet, ARow, ACol); + if roReplaceAll in FReplaceParams.Options then + begin + FWorkbook.DisableNotifications; + while FindNext(FSearchParams, AWorksheet, ARow, ACol) do + begin + r := ARow; + c := ACol; + sheet := AWorksheet; + ExecReplace(AWorksheet, ARow, ACol); + end; + FWorkbook.EnableNotifications; + sheet.SelectCell(r, c); + end; + end; +end; + +function TsSearchEngine.ReplaceNext(const ASearchParams: TsSearchParams; + const AReplaceParams: TsReplaceParams; var AWorksheet: TsWorksheet; + var ARow, ACol: Cardinal): Boolean; +var + r, c: Cardinal; + sheet: TsWorksheet; +begin + Result := FindNext(ASearchParams, AWorksheet, ARow, ACol); + if Result then + begin + FReplaceParams := AReplaceParams; + Result := ExecReplace(AWorksheet, ARow, ACol); + if roReplaceAll in FReplaceParams.Options then + begin + FWorkbook.DisableNotifications; + while FindNext(FSearchParams, AWorksheet, ARow, ACol) do + begin + r := ARow; + c := ACol; + sheet := AWorksheet; + ExecReplace(AWorksheet, ARow, ACol); + end; + FWorkbook.EnableNotifications; + sheet.SelectCell(r, c); + end; + end; +end; + end. diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 4891cc065..d3a63c033 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -724,6 +724,19 @@ type Within: TsSearchWithin; end; + {@@ Replace option } + TsReplaceOption = (roReplaceEntirecell, roReplaceAll, roConfirm); + + {@@ A set of replace options } + TsReplaceOptions = set of TsReplaceOption; + + {@@ Replace parameters } + TsReplaceParams = record + ReplaceText: String; + Options: TsReplaceOptions; + end; + + implementation