systools: Add unit StRegEx and corresponding example

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6144 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-01-17 10:19:01 +00:00
parent 0921d3d4ff
commit 1b82e06d6b
10 changed files with 3221 additions and 4 deletions

View File

@ -0,0 +1,218 @@
object Form1: TForm1
Left = 311
Height = 412
Top = 188
Width = 377
BorderStyle = bsDialog
Caption = 'Regular Expression (StRegEx) Example'
ClientHeight = 412
ClientWidth = 377
Color = clBtnFace
Font.Color = clBlack
Position = poScreenCenter
LCLVersion = '1.9.0.0'
object Label1: TLabel
Left = 144
Height = 15
Top = 12
Width = 57
Caption = 'Source File'
ParentColor = False
end
object Label2: TLabel
Left = 144
Height = 15
Top = 57
Width = 81
Caption = 'Destination File'
ParentColor = False
end
object lblSelAvoid: TLabel
Left = 15
Height = 15
Top = 338
Width = 51
Caption = 'Sel/Avoid'
ParentColor = False
end
object lblMatch: TLabel
Left = 110
Height = 15
Top = 339
Width = 34
Caption = 'Match'
ParentColor = False
end
object lblReplace: TLabel
Left = 200
Height = 15
Top = 339
Width = 41
Caption = 'Replace'
ParentColor = False
end
object lblLPS: TLabel
Left = 15
Height = 15
Top = 361
Width = 50
Caption = 'Lines/Sec'
ParentColor = False
end
object sbSource: TSpeedButton
Left = 342
Height = 22
Top = 29
Width = 23
Caption = '...'
OnClick = SelectFile
end
object sbDest: TSpeedButton
Left = 342
Height = 22
Top = 72
Width = 23
Caption = '...'
OnClick = SelectFile
end
object Progressbar1: TProgressBar
Left = 16
Height = 22
Top = 379
Width = 232
ParentColor = False
TabOrder = 8
end
object gbOptions: TGroupBox
Left = 8
Height = 127
Top = 10
Width = 122
Caption = ' Options '
ClientHeight = 107
ClientWidth = 118
TabOrder = 0
object cbSelect: TCheckBox
Left = 15
Height = 19
Top = 0
Width = 51
Caption = 'Select'
Checked = True
State = cbChecked
TabOrder = 0
end
object cbIgnoreCase: TCheckBox
Left = 15
Height = 19
Top = 21
Width = 82
Caption = 'Ignore Case'
Checked = True
State = cbChecked
TabOrder = 1
end
object cbLineNumbers: TCheckBox
Left = 15
Height = 19
Top = 43
Width = 94
Caption = 'Line Numbers'
TabOrder = 2
end
object cbxModOnly: TCheckBox
Left = 15
Height = 19
Top = 64
Width = 96
Caption = 'Modified Only'
TabOrder = 3
end
object cbxCountOnly: TCheckBox
Left = 15
Height = 19
Top = 85
Width = 86
Caption = 'Counts Only'
TabOrder = 4
end
end
object edtSourceFile: TEdit
Left = 144
Height = 23
Top = 29
Width = 195
TabOrder = 1
end
object edtDestFile: TEdit
Left = 144
Height = 23
Top = 72
Width = 195
TabOrder = 2
end
object bntSelAvoid: TButton
Left = 143
Height = 25
Top = 112
Width = 70
Caption = 'Sel/Avoid'
OnClick = bntSelAvoidClick
TabOrder = 3
end
object btnMatch: TButton
Left = 219
Height = 25
Top = 112
Width = 70
Caption = 'Match'
OnClick = btnMatchClick
TabOrder = 4
end
object btnReplace: TButton
Left = 295
Height = 25
Top = 112
Width = 70
Caption = 'Replace'
OnClick = btnReplaceClick
TabOrder = 5
end
object Memo1: TMemo
Left = 9
Height = 171
Top = 152
Width = 357
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Lines.Strings = (
''
)
ParentFont = False
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 6
TabStop = False
WordWrap = False
end
object Button1: TButton
Left = 280
Height = 25
Top = 378
Width = 75
Caption = 'Execute'
OnClick = Button1Click
TabOrder = 7
end
object OpenDialog1: TOpenDialog
left = 88
top = 208
end
object StRegEx1: TStRegEx
OnProgress = StRegEx1Progress
OutputOptions = []
left = 224
top = 208
end
end

View File

@ -0,0 +1,234 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower SysTools
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$IFDEF FPC}
{$mode DELPHI}
{$ENDIF}
unit Exregeu1;
interface
uses
{$IFNDEF FPC}
Windows, Messages, Gauges,
{$ENDIF}
SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, ComCtrls, Buttons,
StRegEx;
type
TForm1 = class(TForm)
gbOptions: TGroupBox;
cbSelect: TCheckBox;
cbIgnoreCase: TCheckBox;
cbLineNumbers: TCheckBox;
cbxModOnly: TCheckBox;
cbxCountOnly: TCheckBox;
Label1: TLabel;
edtSourceFile: TEdit;
Label2: TLabel;
edtDestFile: TEdit;
bntSelAvoid: TButton;
btnMatch: TButton;
btnReplace: TButton;
Memo1: TMemo;
lblSelAvoid: TLabel;
lblMatch: TLabel;
lblReplace: TLabel;
lblLPS: TLabel;
Button1: TButton;
sbSource: TSpeedButton;
sbDest: TSpeedButton;
OpenDialog1: TOpenDialog;
ProgressBar1: TProgressBar;
StRegEx1: TStRegEx;
procedure SelectFile(Sender: TObject);
procedure bntSelAvoidClick(Sender: TObject);
procedure btnMatchClick(Sender: TObject);
procedure btnReplaceClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure StRegEx1Progress(Sender: TObject; Percent: Word);
procedure StRegEx1Match(Sender: TObject; Position: TMatchPosition);
private
{ Private declarations }
public
{ Public declarations }
ACount : Cardinal;
StRegExClass : TStStreamRegEx;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
uses
ExRegEU2,
StStrS;
procedure TForm1.SelectFile(Sender: TObject);
begin
if (Sender = sbSource) then begin
OpenDialog1.Title := 'Source File';
OpenDialog1.Options := OpenDialog1.Options + [ofFileMustExist];
if OpenDialog1.Execute then
edtSourceFile.Text := OpenDialog1.FileName;
end else begin
OpenDialog1.Title := 'Destination File';
OpenDialog1.Options := OpenDialog1.Options - [ofFileMustExist];
if OpenDialog1.Execute then
edtDestFile.Text := OpenDialog1.FileName;
end;
end;
procedure TForm1.bntSelAvoidClick(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
try
Form2.Memo1.Clear;
Form2.Memo1.Lines.Assign(StRegEx1.SelAvoidPattern);
if (Form2.ShowModal = mrOK) then begin
StRegEx1.SelAvoidPattern.Clear;
StRegEx1.SelAvoidPattern.Assign(Form2.Memo1.Lines);
end;
finally
Form2.Free;
Form2 := nil;
end;
end;
procedure TForm1.btnMatchClick(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
try
Form2.Memo1.Clear;
Form2.Memo1.Lines.Assign(StRegEx1.MatchPattern);
if (Form2.ShowModal = mrOK) then begin
StRegEx1.MatchPattern.Clear;
StRegEx1.MatchPattern.Assign(Form2.Memo1.Lines);
end;
finally
Form2.Free;
Form2 := nil;
end;
end;
procedure TForm1.btnReplaceClick(Sender: TObject);
begin
Form2 := TForm2.Create(Self);
try
Form2.Memo1.Clear;
Form2.Memo1.Lines.Assign(StRegEx1.ReplacePattern);
if (Form2.ShowModal = mrOK) then begin
StRegEx1.ReplacePattern.Clear;
StRegEx1.ReplacePattern.Assign(Form2.Memo1.Lines);
end;
finally
Form2.Free;
Form2 := nil;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ACount := 0;
if cbxModOnly.Checked then
StRegEx1.OutputOptions := StRegEx1.OutputOptions + [ooModified]
else
StRegEx1.OutputOptions := StRegEx1.OutputOptions - [ooModified];
if cbxCountOnly.Checked then
StRegEx1.OutputOptions := StRegEx1.OutputOptions + [ooCountOnly]
else
StRegEx1.OutputOptions := StRegEx1.OutputOptions - [ooCountOnly];
if (TrimS(edtSourceFile.Text) = '') or
((TrimS(edtDestFile.Text) = '') and (not (ooCountOnly in StRegEx1.OutputOptions))) then begin
MessageDlg('Source and/or Destination file cannot be blank',
mtError, [mbOK], 0);
Exit;
end;
if not (FileExists(TrimS(edtSourceFile.Text))) then begin
MessageDlg('Source file not found', mtError, [mbOK], 0);
Exit;
end;
if (StRegEx1.SelAvoidPattern.Count = 0) and
(StRegEx1.MatchPattern.Count = 0) then begin
MessageDlg('You must specify a SelAvoid or Match Pattern',
mtError, [mbOK], 0);
Exit;
end;
StRegEx1.IgnoreCase := cbIgnoreCase.Checked;
StRegEx1.Avoid := not cbSelect.Checked;
StRegEx1.LineNumbers := cbLineNumbers.Checked;
StRegEx1.InputFile := TrimS(edtSourceFile.Text);
StRegEx1.OutputFile := edtDestFile.Text;
lblSelAvoid.Caption := 'Sel/Avoid: 0';
lblMatch.Caption := 'Match: 0';
lblReplace.Caption := 'ReplaceL 0';
lblLPS.Caption := 'Lines/Sec: 0';
Screen.Cursor := crHourglass;
try
StRegEx1.Execute;
finally
Screen.Cursor := crDefault;
end;
Memo1.Clear;
if (not (ooCountOnly in StRegEx1.OutputOptions)) then
Memo1.Lines.LoadFromFile(edtDestFile.Text);
lblSelAvoid.Caption := 'Sel/Avoid: ' + IntToStr(StRegEx1.LinesSelected);
lblMatch.Caption := 'Match: ' + IntToStr(StRegEx1.LinesMatched);
lblReplace.Caption := 'Replace: ' + IntToStr(StRegEx1.LinesReplaced);
lblLPS.Caption := 'Lines/Sec: ' + IntToStr(StRegEx1.LinesPerSecond);
end;
procedure TForm1.StRegEx1Progress(Sender: TObject; Percent: Word);
begin
if (Percent mod 2 = 0) and (Progressbar1.Position <> Percent) then
Progressbar1.Position := Percent;
end;
procedure TForm1.StRegEx1Match(Sender: TObject; Position: TMatchPosition);
begin
Inc(ACount);
Caption := IntToStr(Position.LineNum);
Application.ProcessMessages;
end;
end.

View File

@ -0,0 +1,57 @@
object Form2: TForm2
Left = 415
Top = 348
BorderStyle = bsDialog
Caption = 'Regular Expression Strings'
ClientHeight = 279
ClientWidth = 286
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
Position = poScreenCenter
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 13
Top = 10
Width = 260
Height = 226
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
Font.Style = []
Lines.Strings = (
'')
ParentFont = False
ScrollBars = ssBoth
TabOrder = 0
WordWrap = False
end
object BitBtn1: TBitBtn
Left = 116
Top = 247
Width = 75
Height = 25
Caption = 'OK'
Default = True
ModalResult = 1
NumGlyphs = 2
TabOrder = 1
end
object BitBtn2: TBitBtn
Left = 200
Top = 247
Width = 75
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
NumGlyphs = 2
TabOrder = 2
end
end

View File

@ -0,0 +1,60 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower SysTools
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$IFDEF FPC}
{$mode DELPHI}
{$ENDIF}
unit exregeu2;
interface
uses
{$IFNDEF FPC}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;
type
TForm2 = class(TForm)
Memo1: TMemo;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.lfm}
end.

View File

@ -0,0 +1,87 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="exregex"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="laz_systools"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="exregex.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="exregeu2.pas"/>
<IsPartOfProject Value="True"/>
<HasResources Value="True"/>
</Unit1>
<Unit2>
<Filename Value="exregeu1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Exregeu1"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="exregex"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,47 @@
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower SysTools
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$IFDEF FPC}
{$mode DELPHI}
{$ENDIF}
program Exregex;
uses
Interfaces,
Forms, lclversion,
exregeu1 in 'exregeu1.pas' {Form1},
exregeu2 in 'exregeu2.pas' {Form2};
{$R *.RES}
begin
Application.Scaled := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
Application.Run;
end.

View File

@ -16,7 +16,7 @@
<Description Value="Lazarus port of TurboPower SysTools (Delphi version at https://sourceforge.net/projects/tpsystools/) - runtime package"/> <Description Value="Lazarus port of TurboPower SysTools (Delphi version at https://sourceforge.net/projects/tpsystools/) - runtime package"/>
<License Value="MPL 1.1"/> <License Value="MPL 1.1"/>
<Version Major="4" Release="4"/> <Version Major="4" Release="4"/>
<Files Count="25"> <Files Count="27">
<Item1> <Item1>
<Filename Value="source\run\stbarc.pas"/> <Filename Value="source\run\stbarc.pas"/>
<UnitName Value="StBarC"/> <UnitName Value="StBarC"/>
@ -117,6 +117,14 @@
<Filename Value="source\run\stbcd.pas"/> <Filename Value="source\run\stbcd.pas"/>
<UnitName Value="StBCD"/> <UnitName Value="StBCD"/>
</Item25> </Item25>
<Item26>
<Filename Value="source\run\stregex.pas"/>
<UnitName Value="StRegEx"/>
</Item26>
<Item27>
<Filename Value="source\run\ststrs.pas"/>
<UnitName Value="StStrS"/>
</Item27>
</Files> </Files>
<RequiredPkgs Count="2"> <RequiredPkgs Count="2">
<Item1> <Item1>

View File

@ -10,7 +10,7 @@ interface
uses uses
StBarC, StBase, StConst, StBarPN, StStrL, St2DBarC, StDate, StUtils, StCRC, StBarC, StBase, StConst, StBarPN, StStrL, St2DBarC, StDate, StUtils, StCRC,
StHASH, StToHTML, StStrms, StDict, StIniStm, StDecMth, StExpr, StMath, StHASH, StToHTML, StStrms, StDict, StIniStm, StDecMth, StExpr, StMath,
StFIN, StDateSt, StMoney, StRandom, StStat, StLArr, StBCD; StFIN, StDateSt, StMoney, StRandom, StStat, StLArr, StBCD, StRegEx, StStrS;
implementation implementation

View File

@ -76,7 +76,9 @@ uses
StNVLMat, StNVLMat,
StNVSCol, StNVSCol,
StNVTree, StNVTree,
*)
StRegEx, StRegEx,
(*
StSpawn, StSpawn,
*) *)
StToHTML, StToHTML,
@ -97,8 +99,8 @@ uses
StConst, StConst,
StCrc, StCrc,
StDate, StDate,
(*
StDateSt, StDateSt,
(*
StDict, StDict,
StDQue, StDQue,
StEclpse, StEclpse,
@ -107,10 +109,14 @@ uses
StFIN, StFIN,
(* (*
StFirst, StFirst,
*)
StHASH, StHASH,
(*
StJup, StJup,
StJupsat, StJupsat,
*)
StLArr, StLArr,
(*
StList, StList,
StMars, StMars,
*) *)
@ -207,8 +213,8 @@ begin
TStExpressionEdit, TStExpressionEdit,
TStBarCode, TStBarCode,
TStPNBarCode, TStPNBarCode,
{
TStRegEx, TStRegEx,
{
TStWMDataCopy, TStWMDataCopy,
} }
TStFileToHTML, TStFileToHTML,

File diff suppressed because it is too large Load Diff