paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Add "replace" to search engine.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4316 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2015-09-08 21:43:02 +00:00
parent 50f0b2fbe6
commit a5cbacff27
6 changed files with 583 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/visual/fpsctrls/main.pas
View File

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

291
components/fpspreadsheet/examples/visual/shared/ssearchform.lfm
View File

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

256
components/fpspreadsheet/examples/visual/shared/ssearchform.pas
View File

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

35
components/fpspreadsheet/fpspreadsheet.pas
View File

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

195
components/fpspreadsheet/fpssearch.pas
View File

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

13
components/fpspreadsheet/fpstypes.pas
View File

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