From b0e24dfa3f40a53a18d906983d6fcf90d3906116 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Tue, 6 Nov 2018 17:59:59 +0000 Subject: [PATCH] jvcllaz: Add TJvStrHolder and TJvMultiStringHolder git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6715 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../jvcllaz/design/JvCmp/images/images.txt | 3 +- .../JvCmp/images/tjvmultistringholder.bmp | Bin 0 -> 1654 bytes .../design/JvCmp/images/tjvstrholder.bmp | Bin 0 -> 1654 bytes .../JvCmp/{JvCmpReg.pas => jvdmpreg.pas} | 11 +- .../design/JvCmp/jvstrholdereditor.pas | 76 ++ .../jvcllaz/design/JvCore/jvstringsform.lfm | 167 +++ .../jvcllaz/design/JvCore/jvstringsform.pas | 144 +++ components/jvcllaz/packages/JvCmpD.lpk | 8 +- components/jvcllaz/packages/JvCmpR.lpk | 6 +- components/jvcllaz/packages/JvCoreLazD.lpk | 15 +- components/jvcllaz/resource/jvcmpreg.res | Bin 3428 -> 5140 bytes .../jvcllaz/run/JvCmp/jvstringholder.pas | 964 ++++++++++++++++++ components/jvcllaz/run/JvCore/JvJCLUtils.pas | 76 +- 13 files changed, 1454 insertions(+), 16 deletions(-) create mode 100644 components/jvcllaz/design/JvCmp/images/tjvmultistringholder.bmp create mode 100644 components/jvcllaz/design/JvCmp/images/tjvstrholder.bmp rename components/jvcllaz/design/JvCmp/{JvCmpReg.pas => jvdmpreg.pas} (51%) create mode 100644 components/jvcllaz/design/JvCmp/jvstrholdereditor.pas create mode 100644 components/jvcllaz/design/JvCore/jvstringsform.lfm create mode 100644 components/jvcllaz/design/JvCore/jvstringsform.pas create mode 100644 components/jvcllaz/run/JvCmp/jvstringholder.pas diff --git a/components/jvcllaz/design/JvCmp/images/images.txt b/components/jvcllaz/design/JvCmp/images/images.txt index dcc75cbdb..5ba43caa5 100644 --- a/components/jvcllaz/design/JvCmp/images/images.txt +++ b/components/jvcllaz/design/JvCmp/images/images.txt @@ -1,2 +1,3 @@ +tjvstrholder.bmp +tjvmultistringholder.bmp tjvspellchecker.bmp -tjventerastab.bmp diff --git a/components/jvcllaz/design/JvCmp/images/tjvmultistringholder.bmp b/components/jvcllaz/design/JvCmp/images/tjvmultistringholder.bmp new file mode 100644 index 0000000000000000000000000000000000000000..7f1aff4fd3c1dff9681263a6f80a6afbf173d45c GIT binary patch literal 1654 zcmeH{yAi@L5JXq<7t0w5B~Sq|Lry!yE`?H5iaIfSCs`Pykcjb)rIFw6oX!{cc7L=` zU25RW(3UisAmM;8|i5!XD=vH>A*c|9UL;k^fZz%)(p2w+0R*IoMr_6hvS1P;|o zP1Dq4lv0-^+!$Kq&b3*t9!dGwia(Z&+dgx<4h+W1P7;frHg7MXw$IDA|pJmI|ue84=<@CaZ<6hC+E9oReYCmlF6mAbBL zr=&=oO1Lq!$ers|uANBv*v0{h`%$^wa)wC#FF2!8PB|y{%_679ELrp9ydQZD#h_Jl zp0|j`TJLbo0<&z~K%(C2g(u5>)F(^sU6gW^Z}OFw^1QF|Z|aAf!fR-} 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. + diff --git a/components/jvcllaz/design/JvCore/jvstringsform.lfm b/components/jvcllaz/design/JvCore/jvstringsform.lfm new file mode 100644 index 000000000..c832afb2a --- /dev/null +++ b/components/jvcllaz/design/JvCore/jvstringsform.lfm @@ -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 diff --git a/components/jvcllaz/design/JvCore/jvstringsform.pas b/components/jvcllaz/design/JvCore/jvstringsform.pas new file mode 100644 index 000000000..aaf13ab33 --- /dev/null +++ b/components/jvcllaz/design/JvCore/jvstringsform.pas @@ -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. diff --git a/components/jvcllaz/packages/JvCmpD.lpk b/components/jvcllaz/packages/JvCmpD.lpk index 3a2514df0..3a26ea317 100644 --- a/components/jvcllaz/packages/JvCmpD.lpk +++ b/components/jvcllaz/packages/JvCmpD.lpk @@ -18,12 +18,16 @@ - EnterAsTab component"/> - + - + + + + + diff --git a/components/jvcllaz/packages/JvCmpR.lpk b/components/jvcllaz/packages/JvCmpR.lpk index a27f6ae8f..f80fb6d87 100644 --- a/components/jvcllaz/packages/JvCmpR.lpk +++ b/components/jvcllaz/packages/JvCmpR.lpk @@ -17,7 +17,7 @@ - Spellchecker component"/> - + @@ -30,6 +30,10 @@ + + + + diff --git a/components/jvcllaz/packages/JvCoreLazD.lpk b/components/jvcllaz/packages/JvCoreLazD.lpk index dcc5689b0..c6f6031a6 100644 --- a/components/jvcllaz/packages/JvCoreLazD.lpk +++ b/components/jvcllaz/packages/JvCoreLazD.lpk @@ -17,7 +17,7 @@ - + @@ -26,14 +26,21 @@ + + + + - + - + - + + + + diff --git a/components/jvcllaz/resource/jvcmpreg.res b/components/jvcllaz/resource/jvcmpreg.res index a8ae841d774565fb82e225220d68c26397dab40f..c0698327edee4ec8be53629b47414fd9b50356b6 100644 GIT binary patch literal 5140 zcmeI$y^b3<5Ww*{S$DpiTo`bZl4aiDQsgWGj$u1-J`g*uS>`e3QKm5R9Mc8JGq{*X zaDRZ6Kgr$Iu5<5WVc(%Yxz#z$Sdk! zccPPXumqV#-j-2x&J`dIesd=2^9Sezl|BYM?MHp+ElfCgYl>M*nQaV6#tz5_lHq9jcNEg{{2~^Pfnem8s8_TO^Mg_={Y0p z*QX!kS5~Ii@?u!2UdWH~?3354M;u;tTCet(>C`&S!2fjyPV3dbx?b_0cey_77oR)U zHxBKt{w;WQ+@Hwb?q64*yZYBBDH{eD)~jy_?boYU@-t6SFL^y- zm3qqO_p_&}PkE;5dsGqLJV5n|Pnzwy%HO%X|MPbq{4xqiB!eSFvLJy*E>IX8AyNbh z8GI=UgCmChChCj=g~1UbG{q7!3KRxMaFBw8i~@zh5j-af5;6)D21iI14pS29t3Y9J zL_f8Zs51%_21oSM&WSpsKw)r1pOTWOGYS+2NA&5^M4eHfFgT)5r6uZ&0)@d5eVRQ{ zXA~$5j%b%4N21OsP#7E`%K57#)H5%rFM}gQlOQ3ZKw)r1zic^CXA~$5j_8-PB3KRxMv|C6cQD+n=42}@z{9O_<3KWL= zihgUQM4eHfFgT*$b~#aJ6etXi=(l7^)ENZ|gCqLws);(IKw)r1zm+XfXA~$5j_9|! zC+ds>g~|KdoxG)=G9Ldy+PnT>Qhyt%pZ%wlo&525R&H)?J`B%Avnb6Lzr7{5j6bG7 zQQq5w#1ubBwDD{I?J_ZoFB0?kJTV?8<51SSarYmF(!=Y0qITf?T5q1arVZMLEncHX z3C1Q?KbKpyowmV_;x$THZqQ@LiCKKH#da(8CFDhBLk;nko$sS|>;3B{+x2#skY)dx X>WS-`7{{;SA#qLOu+%NCKa%(hZG|`M delta 674 zcmZvYy-fr$5QU$;KeCao0U`pBD1m_F5SI`T0HOv8AYV!VK|*#ZA)y9eJU`x-ifRi%W5b?{CazrEY;twTWtd;pLUsCL*9La~FP9%A%3H7(4n*f>u&IPP>mZJ( N ';') 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. diff --git a/components/jvcllaz/run/JvCore/JvJCLUtils.pas b/components/jvcllaz/run/JvCore/JvJCLUtils.pas index 91cdf0a9a..e3a7b1b32 100644 --- a/components/jvcllaz/run/JvCore/JvJCLUtils.pas +++ b/components/jvcllaz/run/JvCore/JvJCLUtils.pas @@ -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;