jvcllaz: Add TJvStrHolder and TJvMultiStringHolder
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6715 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
parent
83346b3a99
commit
b0e24dfa3f
@ -1,2 +1,3 @@
|
||||
tjvstrholder.bmp
|
||||
tjvmultistringholder.bmp
|
||||
tjvspellchecker.bmp
|
||||
tjventerastab.bmp
|
||||
|
||||
BIN
components/jvcllaz/design/JvCmp/images/tjvmultistringholder.bmp
Normal file
BIN
components/jvcllaz/design/JvCmp/images/tjvmultistringholder.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
BIN
components/jvcllaz/design/JvCmp/images/tjvstrholder.bmp
Normal file
BIN
components/jvcllaz/design/JvCmp/images/tjvstrholder.bmp
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.6 KiB |
@ -14,17 +14,18 @@ implementation
|
||||
{$R ../../resource/jvcmpreg.res}
|
||||
|
||||
uses
|
||||
Classes, PropEdits,
|
||||
JvDsgnConsts,
|
||||
// JvEnterTab,
|
||||
JvSpellChecker;
|
||||
Classes, PropEdits, ComponentEditors,
|
||||
JvDsgnConsts, //JvDsgnEditors,
|
||||
JvStringHolder, JvSpellChecker,
|
||||
JvStrHolderEditor;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents(RsPaletteJvcl, [
|
||||
// TJvEnterAsTab,
|
||||
TJvStrHolder, TJvMultiStringHolder,
|
||||
TJvSpellChecker
|
||||
]);
|
||||
RegisterComponentEditor(TJvStrHolder, TJvStrHolderEditor);
|
||||
end;
|
||||
|
||||
end.
|
||||
76
components/jvcllaz/design/JvCmp/jvstrholdereditor.pas
Normal file
76
components/jvcllaz/design/JvCmp/jvstrholdereditor.pas
Normal file
@ -0,0 +1,76 @@
|
||||
unit JvStrHolderEditor;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes, Controls,
|
||||
ComponentEditors;
|
||||
|
||||
type
|
||||
TJvStrHolderEditor = class(TDefaultComponentEditor)
|
||||
public
|
||||
procedure Edit; override;
|
||||
procedure ExecuteVerb(AIndex: integer); override;
|
||||
function GetVerb(AIndex: Integer): string; override;
|
||||
function GetVerbCount: Integer; override;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Forms, JvStringHolder, JvStringsForm;
|
||||
|
||||
procedure TJvStrHolderEditor.Edit;
|
||||
var
|
||||
Temp: string;
|
||||
Comp: TPersistent;
|
||||
begin
|
||||
with TJvStrEditDlg.Create(Application) do
|
||||
try
|
||||
Comp := Self.GetComponent;
|
||||
(*
|
||||
if Comp is TComponent then
|
||||
Caption := TComponent(Comp).Name + '.' + GetName
|
||||
else
|
||||
Caption := GetName;
|
||||
Temp := GetStrValue;
|
||||
Memo.Lines.Text := Temp;
|
||||
*)
|
||||
Memo.Lines.Assign((Comp as TJvStrHolder).Strings);
|
||||
UpdateStatus(nil);
|
||||
if ShowModal = mrOk then
|
||||
begin
|
||||
Temp := Memo.Text;
|
||||
while (Length(Temp) > 0) and (Temp[Length(Temp)] < ' ') do
|
||||
System.Delete(Temp, Length(Temp), 1);
|
||||
(Comp as TJvStrHolder).Strings.Text := Temp;
|
||||
// SetStrValue(Temp);
|
||||
end;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolderEditor.ExecuteVerb(AIndex: Integer);
|
||||
begin
|
||||
if AIndex = 0 then Edit;
|
||||
end;
|
||||
|
||||
function TJvStrHolderEditor.GetVerb(AIndex: Integer): string;
|
||||
begin
|
||||
case AIndex of
|
||||
0: Result := 'Strings Editor ----';
|
||||
else Result := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvStrHolderEditor.GetVerbCount: Integer;
|
||||
begin
|
||||
Result := 1;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
167
components/jvcllaz/design/JvCore/jvstringsform.lfm
Normal file
167
components/jvcllaz/design/JvCore/jvstringsform.lfm
Normal file
@ -0,0 +1,167 @@
|
||||
object JvStrEditDlg: TJvStrEditDlg
|
||||
Left = 381
|
||||
Height = 274
|
||||
Top = 76
|
||||
Width = 430
|
||||
ActiveControl = Memo
|
||||
BorderIcons = [biSystemMenu]
|
||||
Caption = 'String list editor'
|
||||
ClientHeight = 274
|
||||
ClientWidth = 430
|
||||
Color = clBtnFace
|
||||
Font.Color = clBlack
|
||||
Icon.Data = {
|
||||
3E01000000000100010010101000010010002801000016000000280000001000
|
||||
0000200000000100040000000000C00000000000000000000000000000000000
|
||||
000000000000000080000080000000808000800000008000800080800000C0C0
|
||||
C000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
|
||||
FF00000000000000000000000BBBB0000000000BB000BB000000000BB0000B00
|
||||
0000000BBB000BB00000000BBB000BB00000000000000BB00000000000000BB0
|
||||
0000000000000BB00000000000000BB00000000000000BB00000000000000BB0
|
||||
0000000000000BB0000000000000BBBB00000000000BBBBBB000000000000000
|
||||
0000FFFF0000F87F0000E73F0000E7BF0000E39F0000E39F0000FF9F0000FF9F
|
||||
0000FF9F0000FF9F0000FF9F0000FF9F0000FF9F0000FF0F0000FE070000FFFF
|
||||
0000
|
||||
}
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '2.1.0.0'
|
||||
object BevelBorder: TBevel
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideTop.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = LoadBtn
|
||||
Left = 8
|
||||
Height = 229
|
||||
Top = 8
|
||||
Width = 414
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Shape = bsFrame
|
||||
end
|
||||
object LineCount: TLabel
|
||||
AnchorSideLeft.Control = BevelBorder
|
||||
AnchorSideTop.Control = BevelBorder
|
||||
Left = 16
|
||||
Height = 17
|
||||
Top = 12
|
||||
Width = 169
|
||||
AutoSize = False
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 4
|
||||
Caption = '0 lines'
|
||||
ParentColor = False
|
||||
end
|
||||
object Memo: TMemo
|
||||
AnchorSideLeft.Control = BevelBorder
|
||||
AnchorSideTop.Control = LineCount
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideRight.Control = BevelBorder
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = BevelBorder
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 16
|
||||
Height = 200
|
||||
Top = 29
|
||||
Width = 398
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
OnChange = UpdateStatus
|
||||
OnKeyDown = MemoKeyDown
|
||||
ScrollBars = ssBoth
|
||||
TabOrder = 0
|
||||
end
|
||||
object OKBtn: TButton
|
||||
AnchorSideRight.Control = CancelBtn
|
||||
Left = 189
|
||||
Height = 25
|
||||
Top = 245
|
||||
Width = 75
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 4
|
||||
Caption = 'OK'
|
||||
Constraints.MinWidth = 75
|
||||
Default = True
|
||||
ModalResult = 1
|
||||
TabOrder = 3
|
||||
end
|
||||
object CancelBtn: TButton
|
||||
AnchorSideTop.Control = LoadBtn
|
||||
AnchorSideRight.Control = HelpBtn
|
||||
Left = 268
|
||||
Height = 25
|
||||
Top = 245
|
||||
Width = 75
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 4
|
||||
Cancel = True
|
||||
Caption = 'Cancel'
|
||||
Constraints.MinWidth = 75
|
||||
ModalResult = 2
|
||||
TabOrder = 4
|
||||
end
|
||||
object HelpBtn: TButton
|
||||
AnchorSideTop.Control = LoadBtn
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
Left = 347
|
||||
Height = 25
|
||||
Top = 245
|
||||
Width = 75
|
||||
Anchors = [akTop, akRight]
|
||||
BorderSpacing.Right = 8
|
||||
Caption = '&Help'
|
||||
Constraints.MinWidth = 75
|
||||
OnClick = HelpBtnClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object LoadBtn: TButton
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 8
|
||||
Height = 25
|
||||
Top = 245
|
||||
Width = 75
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Bottom = 4
|
||||
Caption = '&Load...'
|
||||
Constraints.MinWidth = 75
|
||||
OnClick = FileOpen
|
||||
TabOrder = 1
|
||||
end
|
||||
object SaveBtn: TButton
|
||||
AnchorSideLeft.Control = LoadBtn
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = LoadBtn
|
||||
Left = 87
|
||||
Height = 25
|
||||
Top = 245
|
||||
Width = 75
|
||||
BorderSpacing.Left = 4
|
||||
Caption = '&Save...'
|
||||
Constraints.MinWidth = 75
|
||||
OnClick = FileSave
|
||||
TabOrder = 2
|
||||
end
|
||||
object OpenDialog: TOpenDialog
|
||||
Title = 'Load string list'
|
||||
DefaultExt = '.TXT'
|
||||
Filter = 'Text files (*.TXT)|*.TXT|Config files (*.SYS;*.INI)|*.SYS;*.INI|Batch files (*.BAT)|*.BAT|All files (*.*)|*.*'
|
||||
Options = [ofHideReadOnly, ofShowHelp, ofPathMustExist, ofFileMustExist]
|
||||
left = 292
|
||||
end
|
||||
object SaveDialog: TSaveDialog
|
||||
Title = 'Save string list'
|
||||
Filter = 'Text files (*.TXT)|*.TXT|Config files (*.SYS;*.INI)|*.SYS;*.INI|Batch files (*.BAT)|*.BAT|All files (*.*)|*.*'
|
||||
Options = [ofOverwritePrompt, ofHideReadOnly, ofShowHelp, ofPathMustExist]
|
||||
left = 360
|
||||
end
|
||||
end
|
||||
144
components/jvcllaz/design/JvCore/jvstringsform.pas
Normal file
144
components/jvcllaz/design/JvCore/jvstringsform.pas
Normal file
@ -0,0 +1,144 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
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/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvStrLEdit.PAS, released on 2002-05-26.
|
||||
|
||||
The Initial Developer of the Original Code is Peter Thörnqvist [peter3 att users dott sourceforge dott net]
|
||||
Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist.
|
||||
All Rights Reserved.
|
||||
|
||||
Contributor(s):
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.delphi-jedi.org
|
||||
|
||||
Description:
|
||||
TStrings property editor originally from the Rx library (duplicated for internal use)
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id$
|
||||
|
||||
unit JvStringsForm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
LCLType,
|
||||
Classes,
|
||||
//Windows,
|
||||
Forms, Controls, Dialogs, StdCtrls, ExtCtrls,
|
||||
//DesignIntf, DesignEditors,
|
||||
JvComponent;
|
||||
|
||||
type
|
||||
TJvStrEditDlg = class(TForm) //TJvForm)
|
||||
Memo: TMemo;
|
||||
LineCount: TLabel;
|
||||
OpenDialog: TOpenDialog;
|
||||
SaveDialog: TSaveDialog;
|
||||
OKBtn: TButton;
|
||||
CancelBtn: TButton;
|
||||
HelpBtn: TButton;
|
||||
LoadBtn: TButton;
|
||||
SaveBtn: TButton;
|
||||
BevelBorder: TBevel;
|
||||
procedure FileOpen(Sender: TObject);
|
||||
procedure FileSave(Sender: TObject);
|
||||
procedure UpdateStatus(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure HelpBtnClick(Sender: TObject);
|
||||
private
|
||||
// (rom) removed string[15] to increase flexibility
|
||||
SingleLine: string;
|
||||
MultipleLines: string;
|
||||
FFileName: string;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils, //LibHelp,
|
||||
JvDsgnConsts;
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
procedure TJvStrEditDlg.FileOpen(Sender: TObject);
|
||||
begin
|
||||
with OpenDialog do
|
||||
begin
|
||||
Filter := RsTextFilter;
|
||||
FileName := FFileName;
|
||||
if Execute then
|
||||
begin
|
||||
FFileName := FileName;
|
||||
Memo.Lines.LoadFromFile(FileName);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvStrEditDlg.FileSave(Sender: TObject);
|
||||
begin
|
||||
if SaveDialog.FileName = '' then
|
||||
SaveDialog.FileName := FFileName;
|
||||
with SaveDialog do
|
||||
begin
|
||||
Filter := RsTextFilter;
|
||||
if Execute then
|
||||
Memo.Lines.SaveToFile(FileName);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvStrEditDlg.UpdateStatus(Sender: TObject);
|
||||
var
|
||||
Count: Integer;
|
||||
begin
|
||||
Count := Memo.Lines.Count;
|
||||
if Count = 1 then
|
||||
LineCount.Caption := Format('%d %s', [Count, SingleLine])
|
||||
else
|
||||
LineCount.Caption := Format('%d %s', [Count, MultipleLines]);
|
||||
end;
|
||||
|
||||
procedure TJvStrEditDlg.FormCreate(Sender: TObject);
|
||||
begin
|
||||
(*** NOT CONVERTED ***
|
||||
HelpContext := hcDStringListEditor;
|
||||
OpenDialog.HelpContext := hcDStringListLoad;
|
||||
SaveDialog.HelpContext := hcDStringListSave;
|
||||
***)
|
||||
SingleLine := RsSingleLine;
|
||||
MultipleLines := RsMultipleLines;
|
||||
// set anchors
|
||||
BevelBorder.Anchors := [akLeft, akTop, akRight, akBottom];
|
||||
Memo.Anchors := [akLeft, akTop, akRight, akBottom];
|
||||
OKBtn.Anchors := [akRight, akBottom];
|
||||
CancelBtn.Anchors := [akRight, akBottom];
|
||||
HelpBtn.Anchors := [akRight, akBottom];
|
||||
LoadBtn.Anchors := [akLeft, akBottom];
|
||||
SaveBtn.Anchors := [akLeft, akBottom];
|
||||
end;
|
||||
|
||||
procedure TJvStrEditDlg.MemoKeyDown(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
if Key = VK_ESCAPE then
|
||||
CancelBtn.Click;
|
||||
end;
|
||||
|
||||
procedure TJvStrEditDlg.HelpBtnClick(Sender: TObject);
|
||||
begin
|
||||
Application.HelpContext(HelpContext);
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -18,12 +18,16 @@
|
||||
- EnterAsTab component"/>
|
||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="1">
|
||||
<Files Count="2">
|
||||
<Item1>
|
||||
<Filename Value="..\design\JvCmp\JvCmpReg.pas"/>
|
||||
<Filename Value="..\design\JvCmp\jvcmpreg.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="JvCmpReg"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="..\design\JvCmp\jvstrholdereditor.pas"/>
|
||||
<UnitName Value="JvStrHolderEditor"/>
|
||||
</Item2>
|
||||
</Files>
|
||||
<RequiredPkgs Count="4">
|
||||
<Item1>
|
||||
|
||||
@ -17,7 +17,7 @@
|
||||
- Spellchecker component"/>
|
||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="3">
|
||||
<Files Count="4">
|
||||
<Item1>
|
||||
<Filename Value="..\run\JvCmp\JvSpellChecker.pas"/>
|
||||
<UnitName Value="JvSpellChecker"/>
|
||||
@ -30,6 +30,10 @@
|
||||
<Filename Value="..\run\JvCmp\JvSpellIntf.pas"/>
|
||||
<UnitName Value="JvSpellIntf"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="..\run\JvCmp\jvstringholder.pas"/>
|
||||
<UnitName Value="JvStringHolder"/>
|
||||
</Item4>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
|
||||
@ -17,7 +17,7 @@
|
||||
<Description Value="JVCL Core Components (Designtime). Must be installed before any of the other JvXXX packages can be installed."/>
|
||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="2">
|
||||
<Files Count="3">
|
||||
<Item1>
|
||||
<Filename Value="..\design\JvCore\JvCoreReg.pas"/>
|
||||
<UnitName Value="JvCoreReg"/>
|
||||
@ -26,14 +26,21 @@
|
||||
<Filename Value="..\design\JvCore\JvDsgnConsts.pas"/>
|
||||
<UnitName Value="JvDsgnConsts"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="..\design\JvCore\jvstringsform.pas"/>
|
||||
<UnitName Value="JvStringsForm"/>
|
||||
</Item3>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<RequiredPkgs Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="JvCoreLazR"/>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
<PackageName Value="JvCoreLazR"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item3>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
|
||||
Binary file not shown.
964
components/jvcllaz/run/JvCmp/jvstringholder.pas
Normal file
964
components/jvcllaz/run/JvCmp/jvstringholder.pas
Normal file
@ -0,0 +1,964 @@
|
||||
{-----------------------------------------------------------------------------
|
||||
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/MPL-1.1.html
|
||||
|
||||
Software distributed under the License is distributed on an "AS IS" basis,
|
||||
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
||||
the specific language governing rights and limitations under the License.
|
||||
|
||||
The Original Code is: JvStrHlder.PAS, released on 2002-07-04.
|
||||
|
||||
The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
||||
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
||||
Copyright (c) 2001,2002 SGB Software
|
||||
Portions created by Marc Geldon are Copyright (C) 2004 Marc Geldon.
|
||||
All Rights Reserved.
|
||||
|
||||
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
||||
located at http://jvcl.delphi-jedi.org
|
||||
|
||||
Known Issues:
|
||||
-----------------------------------------------------------------------------}
|
||||
// $Id$
|
||||
|
||||
unit JvStringHolder;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Variants, RTLConsts, SysUtils, Classes;
|
||||
|
||||
type
|
||||
TJvMacros = class;
|
||||
TMacroTextEvent = procedure(Sender: TObject; Data: Variant; var Text: string) of object;
|
||||
|
||||
TJvMacro = class(TCollectionItem)
|
||||
private
|
||||
FName: string;
|
||||
FData: Variant;
|
||||
FOnGetText: TMacroTextEvent;
|
||||
function IsMacroStored: Boolean;
|
||||
function GetText: string;
|
||||
function GetMacros: TJvMacros;
|
||||
protected
|
||||
function GetDisplayName: string; override;
|
||||
procedure SetDisplayName(const Value: string); override;
|
||||
procedure GetMacroText(var AText: string);
|
||||
function GetAsVariant: Variant;
|
||||
procedure SetAsVariant(Value: Variant);
|
||||
public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure Clear;
|
||||
function IsEqual(Value: TJvMacro): Boolean;
|
||||
property Macros: TJvMacros read GetMacros;
|
||||
property Text: string read GetText;
|
||||
published
|
||||
property Name: string read FName write SetDisplayName;
|
||||
property Value: Variant read GetAsVariant write SetAsVariant stored IsMacroStored;
|
||||
property OnGetText: TMacroTextEvent read FOnGetText write FOnGetText;
|
||||
end;
|
||||
|
||||
TJvMacros = class(TOwnedCollection)
|
||||
private
|
||||
function GetMacroValue(const MacroName: string): Variant;
|
||||
procedure SetMacroValue(const MacroName: string; const Value: Variant);
|
||||
function GetItem(Index: Integer): TJvMacro;
|
||||
procedure SetItem(Index: Integer; Value: TJvMacro);
|
||||
public
|
||||
constructor Create(AOwner: TPersistent);
|
||||
procedure AssignValues(Value: TJvMacros);
|
||||
procedure AddMacro(Value: TJvMacro);
|
||||
procedure RemoveMacro(Value: TJvMacro);
|
||||
function CreateMacro(const MacroName: string): TJvMacro;
|
||||
procedure GetMacroList(List: TList; const MacroNames: string);
|
||||
function IndexOf(const AName: string): Integer;
|
||||
function IsEqual(Value: TJvMacros): Boolean;
|
||||
function ParseString(const Value: string; DoCreate: Boolean; SpecialChar: Char): string;
|
||||
function MacroByName(const Value: string): TJvMacro;
|
||||
function FindMacro(const Value: string): TJvMacro;
|
||||
property Items[Index: Integer]: TJvMacro read GetItem write SetItem; default;
|
||||
property MacroValues[const MacroName: string]: Variant read GetMacroValue write SetMacroValue;
|
||||
end;
|
||||
|
||||
TJvStrHolder = class(TComponent)
|
||||
private
|
||||
FStrings: TStringList;
|
||||
FXorKey: string;
|
||||
FReserved: Integer;
|
||||
FMacros: TJvMacros;
|
||||
FMacroChar: Char;
|
||||
FOnExpandMacros: TNotifyEvent;
|
||||
FOnChange: TNotifyEvent;
|
||||
FOnChanging: TNotifyEvent;
|
||||
function GetDuplicates: TDuplicates;
|
||||
procedure SetDuplicates(Value: TDuplicates);
|
||||
function GetSorted: Boolean;
|
||||
procedure SetSorted(Value: Boolean);
|
||||
function GetStrings: TStrings;
|
||||
procedure SetStrings(Value: TStrings);
|
||||
procedure StringsChanged(Sender: TObject);
|
||||
procedure StringsChanging(Sender: TObject);
|
||||
procedure ReadStrings(Reader: TReader);
|
||||
procedure WriteStrings(Writer: TWriter);
|
||||
procedure ReadVersion(Reader: TReader);
|
||||
procedure WriteVersion(Writer: TWriter);
|
||||
function GetCommaText: string;
|
||||
procedure SetCommaText(const Value: string);
|
||||
function GetCapacity: Integer;
|
||||
procedure SetCapacity(NewCapacity: Integer);
|
||||
procedure SetMacros(Value: TJvMacros);
|
||||
procedure RecreateMacros;
|
||||
procedure SetMacroChar(Value: Char);
|
||||
protected
|
||||
procedure AssignTo(Dest: TPersistent); override;
|
||||
procedure DefineProperties(Filer: TFiler); override;
|
||||
procedure Changed; dynamic;
|
||||
procedure Changing; dynamic;
|
||||
procedure BeforeExpandMacros; dynamic;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure Clear;
|
||||
function MacroCount: Integer;
|
||||
function MacroByName(const MacroName: string): TJvMacro;
|
||||
function ExpandMacros: string;
|
||||
property CommaText: string read GetCommaText write SetCommaText;
|
||||
published
|
||||
property Capacity: Integer read GetCapacity write SetCapacity default 0;
|
||||
property MacroChar: Char read FMacroChar write SetMacroChar default '%';
|
||||
property Macros: TJvMacros read FMacros write SetMacros;
|
||||
property OnExpandMacros: TNotifyEvent read FOnExpandMacros write FOnExpandMacros;
|
||||
property Duplicates: TDuplicates read GetDuplicates write SetDuplicates default dupIgnore;
|
||||
property KeyString: string read FXorKey write FXorKey stored False;
|
||||
property Sorted: Boolean read GetSorted write SetSorted default False;
|
||||
property Strings: TStrings read GetStrings write SetStrings stored False;
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
|
||||
end;
|
||||
|
||||
{ MultiStringHolder }
|
||||
|
||||
EJvMultiStringHolderException = class(Exception);
|
||||
|
||||
TJvMultiStringHolderCollectionItem = class(TCollectionItem)
|
||||
private
|
||||
FName: string;
|
||||
FStrings: TStrings;
|
||||
procedure SetName(Value: string);
|
||||
procedure SetStrings(const Value: TStrings);
|
||||
protected
|
||||
function GetDisplayName: string; override;
|
||||
public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
property Name: string read FName write SetName;
|
||||
property Strings: TStrings read FStrings write SetStrings;
|
||||
end;
|
||||
|
||||
TJvMultiStringHolderCollection = class(TOwnedCollection)
|
||||
protected
|
||||
function GetItem(Index: Integer): TJvMultiStringHolderCollectionItem;
|
||||
procedure SetItem(Index: Integer; Value: TJvMultiStringHolderCollectionItem);
|
||||
public
|
||||
function DoesNameExist(const Name: string): Boolean;
|
||||
property Items[Index: Integer]: TJvMultiStringHolderCollectionItem read GetItem write SetItem;
|
||||
function Add: TJvMultiStringHolderCollectionItem;
|
||||
function Insert(Index: Integer): TJvMultiStringHolderCollectionItem;
|
||||
end;
|
||||
|
||||
TJvMultiStringHolder = class(TComponent)
|
||||
private
|
||||
FMultipleStrings: TJvMultiStringHolderCollection;
|
||||
procedure SetMultipleStrings(Value: TJvMultiStringHolderCollection);
|
||||
function GetItemByName(const AName: string): TJvMultiStringHolderCollectionItem;
|
||||
function GetStringsByName(const AName: string): TStrings;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
property ItemByName[const AName: string]: TJvMultiStringHolderCollectionItem read GetItemByName;
|
||||
property StringsByName[const AName: string]: TStrings read GetStringsByName;
|
||||
published
|
||||
property MultipleStrings: TJvMultiStringHolderCollection read FMultipleStrings write SetMultipleStrings;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
//Consts,
|
||||
(*
|
||||
{$IFDEF SUPPORTS_INLINE}
|
||||
Windows,
|
||||
{$ENDIF SUPPORTS_INLINE}
|
||||
*)
|
||||
JvJCLUtils, JvResources, JvConsts, JvTypes;
|
||||
|
||||
const
|
||||
AnsiXorVersion = 1;
|
||||
XorVersion = 2;
|
||||
|
||||
type
|
||||
TCharSet = TSysCharSet;
|
||||
|
||||
function ExtractName(const Items: string; var Pos: Integer): string;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
I := Pos;
|
||||
while (I <= Length(Items)) and (Items[I] <> ';') do
|
||||
Inc(I);
|
||||
Result := Trim(Copy(Items, Pos, I - Pos));
|
||||
if (I <= Length(Items)) and (Items[I] = ';') then
|
||||
Inc(I);
|
||||
Pos := I;
|
||||
end;
|
||||
|
||||
function NameDelimiter(C: Char; Delims: TCharSet): Boolean;
|
||||
begin
|
||||
Result := CharInSet(C, [' ', ',', ';', ')', Cr, Lf]) or CharInSet(C, Delims);
|
||||
end;
|
||||
|
||||
function IsLiteral(C: Char): Boolean;
|
||||
begin
|
||||
case C of
|
||||
'''', '"':
|
||||
Result := True;
|
||||
else
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure CreateMacros(List: TJvMacros; const Value: PChar; SpecialChar: Char; Delims: TCharSet);
|
||||
var
|
||||
CurPos, StartPos: PChar;
|
||||
CurChar: Char;
|
||||
Literal: Boolean;
|
||||
EmbeddedLiteral: Boolean;
|
||||
Name: string;
|
||||
|
||||
function StripLiterals(Buffer: PChar): string;
|
||||
var
|
||||
BufLen: Integer;
|
||||
TempBuf: PChar;
|
||||
|
||||
procedure StripChar(Value: Char);
|
||||
var
|
||||
Len: Integer;
|
||||
begin
|
||||
if TempBuf^ = Value then
|
||||
StrMove(TempBuf, TempBuf + 1, BufLen - 1);
|
||||
Len := StrLen(TempBuf);
|
||||
if TempBuf[Len - 1] = Value then
|
||||
TempBuf[Len - 1] := #0;
|
||||
end;
|
||||
|
||||
begin
|
||||
TempBuf := StrNew(Buffer);
|
||||
BufLen := StrLen(TempBuf) + 1;
|
||||
Result := '';
|
||||
try
|
||||
StripChar('''');
|
||||
StripChar('"');
|
||||
Result := StrPas(TempBuf);
|
||||
finally
|
||||
StrDispose(TempBuf);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if SpecialChar = #0 then
|
||||
Exit;
|
||||
CurPos := Value;
|
||||
Literal := False;
|
||||
EmbeddedLiteral := False;
|
||||
repeat
|
||||
CurChar := CurPos^;
|
||||
if (CurChar = SpecialChar) and not Literal and ((CurPos + 1)^ <> SpecialChar) then
|
||||
begin
|
||||
StartPos := CurPos;
|
||||
while (CurChar <> #0) and (Literal or not NameDelimiter(CurChar, Delims)) do
|
||||
begin
|
||||
Inc(CurPos);
|
||||
CurChar := CurPos^;
|
||||
if IsLiteral(CurChar) then
|
||||
begin
|
||||
Literal := not Literal;
|
||||
if CurPos = StartPos + 1 then
|
||||
EmbeddedLiteral := True;
|
||||
end;
|
||||
end;
|
||||
CurPos^ := #0;
|
||||
if EmbeddedLiteral then
|
||||
begin
|
||||
Name := StripLiterals(StartPos + 1);
|
||||
EmbeddedLiteral := False;
|
||||
end
|
||||
else
|
||||
Name := StrPas(StartPos + 1);
|
||||
if Assigned(List) then
|
||||
if List.FindMacro(Name) = nil then
|
||||
List.CreateMacro(Name);
|
||||
CurPos^ := CurChar;
|
||||
StartPos^ := '?';
|
||||
Inc(StartPos);
|
||||
StrMove(StartPos, CurPos, StrLen(CurPos) + 1);
|
||||
CurPos := StartPos;
|
||||
end
|
||||
else
|
||||
if (CurChar = SpecialChar) and not Literal and ((CurPos + 1)^ = SpecialChar) then
|
||||
StrMove(CurPos, CurPos + 1, StrLen(CurPos) + 1)
|
||||
else
|
||||
if IsLiteral(CurChar) then
|
||||
Literal := not Literal;
|
||||
Inc(CurPos);
|
||||
until CurChar = #0;
|
||||
end;
|
||||
|
||||
//=== { TJvMacro } ===========================================================
|
||||
|
||||
constructor TJvMacro.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FData := Unassigned;
|
||||
end;
|
||||
|
||||
procedure TJvMacro.Assign(Source: TPersistent);
|
||||
begin
|
||||
if Source is TJvMacro then
|
||||
begin
|
||||
if VarIsEmpty(TJvMacro(Source).FData) then
|
||||
Clear
|
||||
else
|
||||
Value := TJvMacro(Source).FData;
|
||||
Name := TJvMacro(Source).Name;
|
||||
end
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
function TJvMacro.GetDisplayName: string;
|
||||
begin
|
||||
if FName = '' then
|
||||
Result := inherited GetDisplayName
|
||||
else
|
||||
Result := FName;
|
||||
end;
|
||||
|
||||
procedure TJvMacro.SetDisplayName(const Value: string);
|
||||
begin
|
||||
if (Value <> '') and (AnsiCompareText(Value, FName) <> 0) and
|
||||
(Collection is TJvMacros) and (TJvMacros(Collection).IndexOf(Value) >= 0) then
|
||||
raise EJVCLException.CreateRes(@SDuplicateString);
|
||||
FName := Value;
|
||||
inherited SetDisplayName(Value);
|
||||
end;
|
||||
|
||||
procedure TJvMacro.GetMacroText(var AText: string);
|
||||
begin
|
||||
if Assigned(FOnGetText) then
|
||||
FOnGetText(Self, FData, AText);
|
||||
end;
|
||||
|
||||
function TJvMacro.GetText: string;
|
||||
begin
|
||||
Result := FData;
|
||||
GetMacroText(Result);
|
||||
end;
|
||||
|
||||
function TJvMacro.GetMacros: TJvMacros;
|
||||
begin
|
||||
if Collection is TJvMacros then
|
||||
Result := TJvMacros(Collection)
|
||||
else
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TJvMacro.Clear;
|
||||
begin
|
||||
FData := Unassigned;
|
||||
end;
|
||||
|
||||
function TJvMacro.IsMacroStored: Boolean;
|
||||
begin
|
||||
Result := not VarIsEmpty(FData);
|
||||
end;
|
||||
|
||||
function TJvMacro.GetAsVariant: Variant;
|
||||
begin
|
||||
Result := FData;
|
||||
end;
|
||||
|
||||
procedure TJvMacro.SetAsVariant(Value: Variant);
|
||||
begin
|
||||
FData := Value;
|
||||
end;
|
||||
|
||||
function TJvMacro.IsEqual(Value: TJvMacro): Boolean;
|
||||
begin
|
||||
Result := (VarType(FData) = VarType(Value.FData)) and
|
||||
(VarIsEmpty(FData) or (FData = Value.FData)) and
|
||||
(Name = Value.Name);
|
||||
end;
|
||||
|
||||
//=== { TJvMacros } ==========================================================
|
||||
|
||||
constructor TJvMacros.Create(AOwner: TPersistent);
|
||||
begin
|
||||
inherited Create(AOwner, TJvMacro);
|
||||
end;
|
||||
|
||||
function TJvMacros.IndexOf(const AName: string): Integer;
|
||||
begin
|
||||
for Result := 0 to Count - 1 do
|
||||
if AnsiSameText(TJvMacro(Items[Result]).Name, AName) then
|
||||
Exit;
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
function TJvMacros.GetItem(Index: Integer): TJvMacro;
|
||||
begin
|
||||
Result := TJvMacro(inherited Items[Index]);
|
||||
end;
|
||||
|
||||
procedure TJvMacros.SetItem(Index: Integer; Value: TJvMacro);
|
||||
begin
|
||||
inherited SetItem(Index, TCollectionItem(Value));
|
||||
end;
|
||||
|
||||
procedure TJvMacros.AddMacro(Value: TJvMacro);
|
||||
begin
|
||||
Value.Collection := Self;
|
||||
end;
|
||||
|
||||
procedure TJvMacros.RemoveMacro(Value: TJvMacro);
|
||||
begin
|
||||
if Value.Collection = Self then
|
||||
Value.Collection := nil;
|
||||
end;
|
||||
|
||||
function TJvMacros.CreateMacro(const MacroName: string): TJvMacro;
|
||||
begin
|
||||
Result := Add as TJvMacro;
|
||||
Result.Name := MacroName;
|
||||
end;
|
||||
|
||||
function TJvMacros.IsEqual(Value: TJvMacros): Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result := Count = Value.Count;
|
||||
if Result then
|
||||
for I := 0 to Count - 1 do
|
||||
begin
|
||||
Result := Items[I].IsEqual(Value.Items[I]);
|
||||
if not Result then
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvMacros.MacroByName(const Value: string): TJvMacro;
|
||||
begin
|
||||
Result := FindMacro(Value);
|
||||
if Result = nil then
|
||||
raise EJVCLException.CreateRes(@SInvalidPropertyValue);
|
||||
end;
|
||||
|
||||
function TJvMacros.FindMacro(const Value: string): TJvMacro;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to Count - 1 do
|
||||
begin
|
||||
Result := TJvMacro(inherited Items[I]);
|
||||
if AnsiSameText(Result.Name, Value) then
|
||||
Exit;
|
||||
end;
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
procedure TJvMacros.AssignValues(Value: TJvMacros);
|
||||
var
|
||||
I: Integer;
|
||||
P: TJvMacro;
|
||||
begin
|
||||
BeginUpdate;
|
||||
try
|
||||
for I := 0 to Value.Count - 1 do
|
||||
begin
|
||||
P := FindMacro(Value[I].Name);
|
||||
if P <> nil then
|
||||
P.Assign(Value[I]);
|
||||
end;
|
||||
finally
|
||||
EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvMacros.ParseString(const Value: string; DoCreate: Boolean;
|
||||
SpecialChar: Char): string;
|
||||
var
|
||||
Macros: TJvMacros;
|
||||
begin
|
||||
Result := Value;
|
||||
Macros := TJvMacros.Create(Self.GetOwner);
|
||||
try
|
||||
CreateMacros(Macros, PChar(Result), SpecialChar, ['.']);
|
||||
if DoCreate then
|
||||
begin
|
||||
Macros.AssignValues(Self);
|
||||
Self.Assign(Macros);
|
||||
end;
|
||||
finally
|
||||
Macros.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvMacros.GetMacroValue(const MacroName: string): Variant;
|
||||
var
|
||||
I: Integer;
|
||||
Macros: TList;
|
||||
begin
|
||||
if Pos(';', MacroName) <> 0 then
|
||||
begin
|
||||
Macros := TList.Create;
|
||||
try
|
||||
GetMacroList(Macros, MacroName);
|
||||
Result := VarArrayCreate([0, Macros.Count - 1], varVariant);
|
||||
for I := 0 to Macros.Count - 1 do
|
||||
Result[I] := TJvMacro(Macros[I]).Value;
|
||||
finally
|
||||
Macros.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result := MacroByName(MacroName).Value;
|
||||
end;
|
||||
|
||||
procedure TJvMacros.SetMacroValue(const MacroName: string;
|
||||
const Value: Variant);
|
||||
var
|
||||
I: Integer;
|
||||
Macros: TList;
|
||||
begin
|
||||
if Pos(';', MacroName) <> 0 then
|
||||
begin
|
||||
Macros := TList.Create;
|
||||
try
|
||||
GetMacroList(Macros, MacroName);
|
||||
for I := 0 to Macros.Count - 1 do
|
||||
TJvMacro(Macros[I]).Value := Value[I];
|
||||
finally
|
||||
Macros.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
MacroByName(MacroName).Value := Value;
|
||||
end;
|
||||
|
||||
procedure TJvMacros.GetMacroList(List: TList; const MacroNames: string);
|
||||
var
|
||||
Pos, Len: Integer;
|
||||
begin
|
||||
Pos := 1;
|
||||
Len := Length(MacroNames);
|
||||
while Pos <= Len do
|
||||
List.Add(MacroByName(ExtractName(MacroNames, Pos)));
|
||||
end;
|
||||
|
||||
//=== { TJvStrHolder } =======================================================
|
||||
|
||||
constructor TJvStrHolder.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FStrings := TStringList.Create;
|
||||
FMacros := TJvMacros.Create(Self);
|
||||
FMacroChar := '%';
|
||||
FStrings.OnChange := @StringsChanged;
|
||||
FStrings.OnChanging := @StringsChanging;
|
||||
end;
|
||||
|
||||
destructor TJvStrHolder.Destroy;
|
||||
begin
|
||||
FOnChange := nil;
|
||||
FOnChanging := nil;
|
||||
FMacros.Free;
|
||||
FStrings.OnChange := nil;
|
||||
FStrings.OnChanging := nil;
|
||||
FStrings.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.Assign(Source: TPersistent);
|
||||
begin
|
||||
if Source is TStrings then
|
||||
FStrings.Assign(Source)
|
||||
else
|
||||
if Source is TJvStrHolder then
|
||||
FStrings.Assign(TJvStrHolder(Source).Strings)
|
||||
else
|
||||
inherited Assign(Source);
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.AssignTo(Dest: TPersistent);
|
||||
begin
|
||||
if Dest is TStrings then
|
||||
Dest.Assign(Strings)
|
||||
else
|
||||
inherited AssignTo(Dest);
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.Changed;
|
||||
begin
|
||||
if Assigned(FOnChange) then
|
||||
FOnChange(Self);
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.Changing;
|
||||
begin
|
||||
if Assigned(FOnChanging) then
|
||||
FOnChanging(Self);
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.Clear;
|
||||
begin
|
||||
Strings.Clear;
|
||||
end;
|
||||
|
||||
function TJvStrHolder.GetCommaText: string;
|
||||
begin
|
||||
Result := Strings.CommaText;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.SetCommaText(const Value: string);
|
||||
begin
|
||||
Strings.CommaText := Value;
|
||||
end;
|
||||
|
||||
function TJvStrHolder.GetCapacity: Integer;
|
||||
begin
|
||||
Result := Strings.Capacity;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.SetCapacity(NewCapacity: Integer);
|
||||
begin
|
||||
Strings.Capacity := NewCapacity;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.BeforeExpandMacros;
|
||||
begin
|
||||
if Assigned(FOnExpandMacros) then
|
||||
FOnExpandMacros(Self);
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.SetMacros(Value: TJvMacros);
|
||||
begin
|
||||
FMacros.AssignValues(Value);
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.RecreateMacros;
|
||||
begin
|
||||
if not (csReading in ComponentState) then
|
||||
Macros.ParseString(Strings.Text, True, MacroChar);
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.SetMacroChar(Value: Char);
|
||||
begin
|
||||
if Value <> FMacroChar then
|
||||
begin
|
||||
FMacroChar := Value;
|
||||
RecreateMacros;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TJvStrHolder.MacroCount: Integer;
|
||||
begin
|
||||
Result := Macros.Count;
|
||||
end;
|
||||
|
||||
function TJvStrHolder.MacroByName(const MacroName: string): TJvMacro;
|
||||
begin
|
||||
Result := Macros.MacroByName(MacroName);
|
||||
end;
|
||||
|
||||
function TJvStrHolder.ExpandMacros: string;
|
||||
var
|
||||
I, J, P, LiteralChars: Integer;
|
||||
Macro: TJvMacro;
|
||||
Found: Boolean;
|
||||
begin
|
||||
BeforeExpandMacros;
|
||||
Result := Strings.Text;
|
||||
for I := Macros.Count - 1 downto 0 do
|
||||
begin
|
||||
Macro := Macros[I];
|
||||
if not VarIsEmpty(Macro.FData) then
|
||||
begin
|
||||
repeat
|
||||
P := Pos(MacroChar + Macro.Name, Result);
|
||||
Found := (P > 0) and ((Length(Result) = P + Length(Macro.Name)) or
|
||||
NameDelimiter(Result[P + Length(Macro.Name) + 1], ['.']));
|
||||
if Found then
|
||||
begin
|
||||
LiteralChars := 0;
|
||||
for J := 1 to P - 1 do
|
||||
if IsLiteral(Result[J]) then
|
||||
Inc(LiteralChars);
|
||||
Found := LiteralChars mod 2 = 0;
|
||||
if Found then
|
||||
begin
|
||||
Result := Copy(Result, 1, P - 1) + Macro.Text + Copy(Result,
|
||||
P + Length(Macro.Name) + 1, MaxInt);
|
||||
end;
|
||||
end;
|
||||
until not Found;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.DefineProperties(Filer: TFiler);
|
||||
|
||||
function DoWrite: Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
Ancestor: TJvStrHolder;
|
||||
begin
|
||||
Ancestor := TJvStrHolder(Filer.Ancestor);
|
||||
Result := False;
|
||||
if (Ancestor <> nil) and (Ancestor.Strings.Count = Strings.Count) and
|
||||
(KeyString = Ancestor.KeyString) and (Strings.Count > 0) then
|
||||
for I := 0 to Strings.Count - 1 do
|
||||
begin
|
||||
Result := CompareText(Strings[I], Ancestor.Strings[I]) <> 0;
|
||||
if Result then
|
||||
Break;
|
||||
end
|
||||
else
|
||||
Result := (Strings.Count > 0) or (KeyString <> '');
|
||||
end;
|
||||
|
||||
begin
|
||||
inherited DefineProperties(Filer);
|
||||
{ for backward compatibility }
|
||||
Filer.DefineProperty('InternalVer', @ReadVersion, @WriteVersion, Filer.Ancestor = nil);
|
||||
Filer.DefineProperty('StrData', @ReadStrings, @WriteStrings, DoWrite);
|
||||
end;
|
||||
|
||||
function TJvStrHolder.GetSorted: Boolean;
|
||||
begin
|
||||
Result := FStrings.Sorted;
|
||||
end;
|
||||
|
||||
function TJvStrHolder.GetDuplicates: TDuplicates;
|
||||
begin
|
||||
Result := FStrings.Duplicates;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.ReadStrings(Reader: TReader);
|
||||
var
|
||||
Tmp: string;
|
||||
begin
|
||||
Strings.BeginUpdate;
|
||||
try
|
||||
Reader.ReadListBegin;
|
||||
if not Reader.EndOfList then
|
||||
KeyString := Reader.ReadString;
|
||||
Strings.Clear;
|
||||
while not Reader.EndOfList do
|
||||
begin
|
||||
Tmp := Reader.ReadString;
|
||||
if FReserved >= AnsiXorVersion then
|
||||
begin
|
||||
if FReserved >= XorVersion then
|
||||
Strings.Add(XorDecodeString(KeyString, Tmp))
|
||||
else
|
||||
{$WARNINGS OFF} // XorDecode is deprecated, but we need it for backward compatibility, so hide the warning
|
||||
Strings.Add(XorDecode(KeyString, Tmp));
|
||||
{$WARNINGS ON}
|
||||
end
|
||||
else
|
||||
Strings.Add(string(XorString(ShortString(KeyString), ShortString(Tmp))));
|
||||
end;
|
||||
Reader.ReadListEnd;
|
||||
finally
|
||||
Strings.EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.SetDuplicates(Value: TDuplicates);
|
||||
begin
|
||||
FStrings.Duplicates := Value;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.SetSorted(Value: Boolean);
|
||||
begin
|
||||
FStrings.Sorted := Value;
|
||||
end;
|
||||
|
||||
function TJvStrHolder.GetStrings: TStrings;
|
||||
begin
|
||||
Result := FStrings;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.SetStrings(Value: TStrings);
|
||||
begin
|
||||
if Value <> FStrings then
|
||||
FStrings.Assign(Value);
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.StringsChanged(Sender: TObject);
|
||||
begin
|
||||
RecreateMacros;
|
||||
if not (csReading in ComponentState) then
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.StringsChanging(Sender: TObject);
|
||||
begin
|
||||
if not (csReading in ComponentState) then
|
||||
Changing;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.WriteStrings(Writer: TWriter);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Writer.WriteListBegin;
|
||||
Writer.WriteString(KeyString);
|
||||
for I := 0 to Strings.Count - 1 do
|
||||
Writer.WriteString(XorEncodeString(KeyString, Strings[I]));
|
||||
Writer.WriteListEnd;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.ReadVersion(Reader: TReader);
|
||||
begin
|
||||
FReserved := Reader.ReadInteger;
|
||||
end;
|
||||
|
||||
procedure TJvStrHolder.WriteVersion(Writer: TWriter);
|
||||
begin
|
||||
Writer.WriteInteger(XorVersion);
|
||||
end;
|
||||
|
||||
//=== { TJvMultiStringHolderCollectionItem } =================================
|
||||
|
||||
procedure TJvMultiStringHolderCollectionItem.SetName(Value: string);
|
||||
begin
|
||||
Value := Trim(Value);
|
||||
if Value = '' then
|
||||
FName := ''
|
||||
else
|
||||
begin
|
||||
if not TJvMultiStringHolderCollection(Collection).DoesNameExist(Value) then
|
||||
FName := Value
|
||||
else
|
||||
raise EJVCLException.CreateRes(@SDuplicateString);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvMultiStringHolderCollectionItem.SetStrings(const Value: TStrings);
|
||||
begin
|
||||
if Value <> FStrings then
|
||||
FStrings.Assign(Value);
|
||||
end;
|
||||
|
||||
function TJvMultiStringHolderCollectionItem.GetDisplayName: string;
|
||||
begin
|
||||
if FName <> '' then
|
||||
Result := FName
|
||||
else
|
||||
Result := RsNoName;
|
||||
end;
|
||||
|
||||
constructor TJvMultiStringHolderCollectionItem.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FStrings := TStringList.Create;
|
||||
end;
|
||||
|
||||
destructor TJvMultiStringHolderCollectionItem.Destroy;
|
||||
begin
|
||||
FStrings.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
//=== { TJvMultiStringHolderCollection } =====================================
|
||||
|
||||
function TJvMultiStringHolderCollection.GetItem(Index: Integer): TJvMultiStringHolderCollectionItem;
|
||||
begin
|
||||
Result := TJvMultiStringHolderCollectionItem(inherited GetItem(Index));
|
||||
end;
|
||||
|
||||
procedure TJvMultiStringHolderCollection.SetItem(Index: Integer; Value: TJvMultiStringHolderCollectionItem);
|
||||
begin
|
||||
inherited SetItem(Index, Value);
|
||||
end;
|
||||
|
||||
function TJvMultiStringHolderCollection.DoesNameExist(const Name: string): Boolean;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
Result := True;
|
||||
for I := 0 to Count - 1 do
|
||||
if CompareText(Items[I].Name, Name) = 0 then
|
||||
Exit;
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
function TJvMultiStringHolderCollection.Add: TJvMultiStringHolderCollectionItem;
|
||||
begin
|
||||
Result := TJvMultiStringHolderCollectionItem(inherited Add);
|
||||
end;
|
||||
|
||||
function TJvMultiStringHolderCollection.Insert(Index: Integer): TJvMultiStringHolderCollectionItem;
|
||||
begin
|
||||
Result := Add;
|
||||
Result.Index := Index;
|
||||
end;
|
||||
|
||||
//=== { TJvMultiStringHolder } ===============================================
|
||||
|
||||
constructor TJvMultiStringHolder.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FMultipleStrings := TJvMultiStringHolderCollection.Create(Self, TJvMultiStringHolderCollectionItem);
|
||||
end;
|
||||
|
||||
destructor TJvMultiStringHolder.Destroy;
|
||||
begin
|
||||
FMultipleStrings.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TJvMultiStringHolder.SetMultipleStrings(Value: TJvMultiStringHolderCollection);
|
||||
begin
|
||||
if Value <> FMultipleStrings then
|
||||
FMultipleStrings.Assign(Value);
|
||||
end;
|
||||
|
||||
function TJvMultiStringHolder.GetItemByName(const AName: string): TJvMultiStringHolderCollectionItem;
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to MultipleStrings.Count - 1 do
|
||||
if CompareText(MultipleStrings.Items[I].Name, AName) = 0 then
|
||||
begin
|
||||
Result := MultipleStrings.Items[I];
|
||||
Exit;
|
||||
end;
|
||||
raise EJvMultiStringHolderException.CreateResFmt(@RsENoItemFoundWithName, [AName]);
|
||||
end;
|
||||
|
||||
function TJvMultiStringHolder.GetStringsByName(const AName: string): TStrings;
|
||||
begin
|
||||
Result := GetItemByName(AName).Strings;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
@ -658,10 +658,15 @@ function FindPart(const HelpWilds, InputStr: string): Integer;
|
||||
function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
|
||||
{ IsWild compares InputString with WildCard string and returns True
|
||||
if corresponds. }
|
||||
function XorString(const Key, Src: ShortString): ShortString;
|
||||
function XorEncode(const Key, Source: string): string;
|
||||
function XorDecode(const Key, Source: string): string;
|
||||
*)
|
||||
|
||||
function XorString(const Key, Src: ShortString): ShortString;
|
||||
function XorEncode(const Key, Source: string): string; deprecated 'use XorEncodeString that has support for non-ASCII chars';
|
||||
function XorDecode(const Key, Source: string): string; deprecated 'use XorDecodeString that has support for non-ASCII chars';
|
||||
function XorEncodeString(const Key, Source: string): string;
|
||||
function XorDecodeString(const Key, Source: string): string;
|
||||
|
||||
(*
|
||||
{ ** Command line routines ** }
|
||||
|
||||
function GetCmdLineArg(const Switch: string; ASwitchChars: TSysCharSet): string;
|
||||
@ -6546,6 +6551,7 @@ begin
|
||||
if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then
|
||||
Result := False;
|
||||
end;
|
||||
*)
|
||||
|
||||
function XorString(const Key, Src: ShortString): ShortString;
|
||||
var
|
||||
@ -6592,6 +6598,70 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function XorEncodeString(const Key, Source: string): string;
|
||||
const
|
||||
HexChars: array[0..15] of Char =
|
||||
('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
|
||||
var
|
||||
I, KeyLen: Integer;
|
||||
C: Byte;
|
||||
Utf8Src, Utf8Key: UTF8String;
|
||||
begin
|
||||
Result := '';
|
||||
Utf8Src := UTF8Encode(Source);
|
||||
Utf8Key := UTF8Encode(Key);
|
||||
KeyLen := Length(Utf8Key);
|
||||
SetLength(Result, Length(Utf8Src) * 2);
|
||||
for I := 1 to Length(Utf8Src) do
|
||||
begin
|
||||
if KeyLen > 0 then
|
||||
C := Byte(Utf8Src[I]) xor Byte(Utf8Key[1 + ((I - 1) mod KeyLen)])
|
||||
else
|
||||
C := Byte(Utf8Src[I]);
|
||||
Result[1 + (I - 1) * 2] := HexChars[C shr 4];
|
||||
Result[1 + (I - 1) * 2 + 1] := HexChars[C and $0F];
|
||||
end;
|
||||
end;
|
||||
|
||||
function XorDecodeString(const Key, Source: string): string;
|
||||
var
|
||||
I, KeyLen: Integer;
|
||||
C: Char;
|
||||
B: Byte;
|
||||
Utf8Result, Utf8Key: UTF8String;
|
||||
begin
|
||||
Result := '';
|
||||
Utf8Key := UTF8Encode(Key);
|
||||
KeyLen := Length(Utf8Key);
|
||||
SetLength(Utf8Result, Length(Source) div 2);
|
||||
for I := 0 to Length(Source) div 2 - 1 do
|
||||
begin
|
||||
// HexToInt
|
||||
C := Source[1 + I * 2];
|
||||
case C of
|
||||
'0'..'9': B := Ord(C) - Ord('0');
|
||||
'A'..'F': B := Ord(C) - 55;
|
||||
'a'..'f': B := Ord(C) - 87;
|
||||
else
|
||||
B := Ord(' ');
|
||||
end;
|
||||
B := B shl 4;
|
||||
C := Source[1 + I * 2 + 1];
|
||||
case C of
|
||||
'0'..'9': B := B or (Ord(C) - Ord('0'));
|
||||
'A'..'F': B := B or (Ord(C) - 55);
|
||||
'a'..'f': B := B or (Ord(C) - 87);
|
||||
else
|
||||
B := Ord(' ');
|
||||
end;
|
||||
if KeyLen > 0 then
|
||||
B := B xor Byte(Utf8Key[1 + (I mod KeyLen)]);
|
||||
Utf8Result[1 + I] := AnsiChar(B);
|
||||
end;
|
||||
Result := UTF8Decode(Utf8Result);
|
||||
end;
|
||||
|
||||
(*
|
||||
function GetCmdLineArg(const Switch: string; ASwitchChars: TSysCharSet): string;
|
||||
var
|
||||
I: Integer;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user