TRichView.com

In order to keep some ponctuation symbos from splitting from the previous word (when they have different formats), I use the function below:

procedure Keeptogether(const ve1: TRichViewEdit; const inicio: integer);
var
j, li1, li2 {, k}: Integer;
i1, i2: string;
changed, atualizar: Boolean;
tentativas: Integer;
begin
tentativas := 0;
repeat
changed := False;
for j := ve1.ItemCount - 2 downto inicio do
if ((ve1.GetItemStyle(j) >= 0) and (ve1.GetItemStyle(j + 1) >= 0) and ve1.GetItem(j + 1).sameasprev) then
begin
i1 := ve1.getitemtexta(j);
i2 := ve1.getitemtexta(j + 1);

li1 := Length(i1);
li2 := Length(i2);
atualizar := false;
if ((li1 > 0) and (li2 > 0)) then
if ((i1[li1] <> ' ') and (i2[1] <> ' ')) then
begin
if ((li1 > 0) and (li2 > 0)) then
if Pos(i2[1], ';,:)}">]’”.') > 0 then
begin
i1 := i1 + i2[1];
if li2 = 1 then
i2 := ''
else
i2 := Copy(i2, 2, li2 - 1);
changed := true;
atualizar := true;
end
else
if Pos(i1[li1], '({"<[‘“') > 0 then
begin
i2 := i1[li1] + i2;
if li1 = 1 then
i1 := ''
else
i1 := Copy(i1, 1, li1 - 1);
changed := true;
atualizar := true;
end;
if atualizar then
begin
ve1.SetItemTextA(j, i1);
ve1.SetItemTextA(j + 1, i2);
end;
end;
end;
Inc(tentativas);
until ((changed = False) or (tentativas > 10));

tentativas := 0;
repeat
changed := False;
for j := ve1.ItemCount - 2 downto inicio do
if ((ve1.GetItemStyle(j) >= 0) and (ve1.GetItemStyle(j + 1) >= 0) and ve1.GetItem(j + 1).SameAsPrev) then
begin
i1 := ve1.getitemtexta(j);
i2 := ve1.getitemtexta(j + 1);

li1 := Length(i1);
li2 := Length(i2);
if ((li1 > 0) and (li2 > 0)) then
if ((i2 = ' ') and not (fsunderline in ve1.Style.TextStyles[ve1.GetItemStyle(j)].Style)) then
begin
i1 := i1 + i2;
i2 := '';
changed := true;
ve1.setitemtexta(j, i1);
ve1.setitemtexta(j + 1, i2);
end;
end;

Inc(tentativas);
until ((changed = False) or (tentativas > 10));

NormalizeRichView(ve1.RVData);
ve1.ClearUndo;
ve1.Format;
if changed then
ShowMessage('Failure.');

end;


The problem is, although the procedure worked fine with TRichView, now I keep receiving the error List index out of bounds (NNN) when I try to format the document. I tried replacing setitemtexta with InsertTextA/DeleteSelection to no avail.

Hi, I think I foud out the bug in my code: I inserted NormalizaRuchView/ClearUndo/Format before the second loop, and everything seems to be working fine now.

Edit 1: Sorry to say that the error remains. It is odd, because all the operations seem to be legal, so I would not expect to be an error in the document structure - what I think is the more likely culprit. The error takes place in TSRichViewEdit.DrawComponents.

Edit 2: I have made a small project to isolate the error (using the Actions SRV Demo).
I added the following lines to the end of TForm3.FormCreate:

SRichViewEdit1.SelectAll;
rvActionsResource.rvActionFontUnderline1.Execute;
MesmaLinha(SRichViewEdit1.RichViewEdit,0, true);
SemSublinhado(SRichViewEdit1.RichViewEdit,0);

The procedures are:

procedure SemSublinhado(ve1: TRichViewEdit; const inicio: integer);
var
i, j, ns, k: Integer;
aux: string;
begin
for j := ve1.itemcount - 1 downto inicio do
begin
ns := ve1.GetItemStyle(j);
if j < 0 then Continue;
if fsunderline in ve1.Style.TextStyles[ns].style then
begin
aux := ve1.GetItemTextA(j);
k := 0;
for i := 1 to Length(aux) do
if aux = ' ' then
Inc(k);
if k > 0 then
begin
ve1.SetSelectionBounds(j, 0, j, 0);
for i := 1 to k do
begin
if ve1.SearchTextA(' ', [rvseoDown]) then
begin
with rvActionsResource.rvActionFontEx1 do begin
UserInterface := False;
ValidProperties := [rvfimUnderline];
Font.Style := [];
Execute;
UserInterface := True;
end;
end;
end;
end;
end;
end;
end;



procedure Mesmalinha(const ve1: TRichViewEdit; const inicio: integer; const repara: boolean);
var
j, li1, li2 {, k}: Integer;
i1, i2: string;
changed, atualizar: Boolean;
tentativas: Integer;

begin
tentativas := 0;
try
repeat
changed := False;
for j := ve1.ItemCount - 2 downto inicio do
if ((ve1.GetItemStyle(j) >= 0) and (ve1.GetItemStyle(j + 1) >= 0) and ve1.GetItem(j + 1).sameasprev) then
begin
i1 := ve1.getitemtexta(j);
i2 := ve1.getitemtexta(j + 1);

li1 := Length(i1);
li2 := Length(i2);
atualizar := false;
if ((li1 > 0) and (li2 > 0)) then
if ((i1[li1] <> ' ') and (i2[1] <> ' ')) then
begin
if Pos(i2[1], ';,:)}">]’”.') > 0 then
begin
i1 := i1 + i2[1];
if li2 = 1 then
i2 := ''
else
i2 := Copy(i2, 2, li2 - 1);
changed := true;
atualizar := true;
end
else
if Pos(i1[li1], '({"<[‘“') > 0 then
begin
i2 := i1[li1] + i2;
if li1 = 1 then
i1 := ''
else
i1 := Copy(i1, 1, li1 - 1);
changed := true;
atualizar := true;
end;
if atualizar then
begin
if i2<>'' then
ve1.SetItemTextA(j+1, i2)
else
ve1.DeleteItems(j+1,1);
if i1<>'' then
ve1.SetItemTextA(j, i1)
else
ve1.DeleteItems(j,1);

end;
end;
end;
Inc(tentativas);
until ((changed = False) or (tentativas > 10));

if repara then
begin
NormalizeRichView(ve1.RVData);
ve1.ClearUndo;
ve1.Format;
tentativas := 0;
repeat
changed := False;
for j := ve1.ItemCount - 2 downto inicio do
if ((ve1.GetItemStyle(j) >= 0) and (ve1.GetItemStyle(j + 1) >= 0) and ve1.GetItem(j + 1).SameAsPrev) then
begin
i1 := ve1.getitemtexta(j);
i2 := ve1.getitemtexta(j + 1);

li1 := Length(i1);
li2 := Length(i2);
if ((li1 > 0) and (li2 =1)) then
if ((i2 = ' ') and not (fsunderline in ve1.Style.TextStyles[ve1.GetItemStyle(j)].Style)) then
begin
i1 := i1 + i2;
i2 := '';
changed := true;
ve1.DeleteItems(j+1,1);
ve1.SetItemTextA(j, i1);
end;
end;

Inc(tentativas);
until ((changed = False) or (tentativas > 10));
end;
finally
NormalizeRichView(ve1.RVData);
ve1.ClearUndo;
ve1.Format;
end;
if changed then
ShowMessage('Houve erro ao formatar texto.');

end;

The error happens as soon as the program starts.

Add SRichViewEdit1.CalculatePageCount;
After RV.Format it is necessary to cause SRV.CalculatePageCount. In new versions we automate this action.

In addition: It is desirable to switch off updating of the screen at SRV.

1) Hi, Thanks for the pointers, but I did as told (after moving the code to the OnClick event of a button, so that I could test it more extensively), but still kept getting the same error: List Index out of Bounds (948). (This error does not happen every time the button is pressed. It sometimes happens when formatting is applied to the document.).

2) I had already tried setting CanUpdate to false, but the editor was (and is) still being refreshed. (It is not important, anyway, as originally I was not using edit operations, but a procedure adapted from the mark and search demo. I tried to use edit operations - for both procedures, but have already reverted one of them to the original form - in order to try to find out what was causing the errors.)

Edit 1: I called SRichViewEdit1.CalculatePageCount after each ve1.format.

Yes is bug SclRVRuler. There are two decisions:
1) to replace a code in RVECaretMove (SclRVRuler.pas) on: 2) to add lines a code:

Many thanks. Should I still uses CalculatePageCount?

Yes. At formatting we realise automatic calculation of pages in the following version. In version RV11.0.3 and SRV2.0.4 it is necessary to use CalculatePageCount.

Hi,
I tested the program using the procedure adapted from the mark and search demo, and again received the error 'List index out of bounds (948)'.

The code that causes the error is:

SRichViewEdit1.CanUpdate := False; // ----------------- ADD
SRichViewEdit1.CanUpdateMargin := False; // ----------------- ADD
SclRVRuler1.CanUpdate := False; // ----------------- Not necessarily
SclRVRuler2.CanUpdate := False; // ----------------- Not necessarily SRichViewEdit1.SelectAll;
SRichViewEdit1.SelectAll;
rvActionsResource.rvActionFontUnderline1.Execute;
MesmaLinha(SRichViewEdit1.RichViewEdit,0, true);
MarkSubStringA(' ', 0, graphics.clNone, graphics.clNone, True, False, SRichViewEdit1.RichViewEdit);

NormalizeRichView(SRichViewEdit1.RichViewEdit.RVData);
SRichViewEdit1.RichViewEdit.ClearUndo;
SRichViewEdit1.RichViewEdit.Format;
SRichViewEdit1.CalculatePageCount;

SRichViewEdit1.CanUpdateMargin := True; // ----------------- ADD
SRichViewEdit1.CanUpdate := True; // ----------------- ADD
SclRVRuler1.CanUpdate := True; // ----------------- Not necessarily
SclRVRuler2.CanUpdate := True; // ----------------- Not necessarily

The (adapted) procedure MarkSubStringA, and other needed procedures and functions, are:


function GetMarkedStyle(RVStyle: TRVStyle; StyleNo: Integer): Integer;
begin
// Result := RVStyle.TextStyles.FindStyleWithColor(StyleNo, clBlack, clSkyBlue);
Result := RVStyle.TextStyles.FindStyleWithFontStyle(StyleNo, [], [fsBold, fsUnderline, fsItalic, fsStrikeOut]);
if Result < 0 then begin
Result := RVStyle.TextStyles.Count;
with RVStyle.TextStyles.Add do begin
Assign(RVStyle.TextStyles[StyleNo]);
style := style - [fsBold] - [fsUnderline] - [fsItalic] - [fsStrikeOut];
Standard := False;
end;
end;
end;

type TSetOfChar = set of TRVAnsiChar;

// Returns the address of the first occurence of SubStr in S (nil if not found).
// Copied from JVCL, fixed
function StrPosW(S, SubStr: PRVUnicodeChar): PRVUnicodeChar;
var
P: PRVUnicodeChar;
I: Integer;
begin
Result := nil;
if (S = nil) or (SubStr = nil) or
(S[0] = #0) or (SubStr[0] = #0) then
Exit;
Result := S;
while Result[0] <> #0 do
begin
if Result[0] <> SubStr[0] then
Inc(Result)
else
begin
P := Result + 1;
I := 1; // fix
while (P[0] <> #0) and (P[0] = SubStr) do
begin
Inc(I);
Inc(P);
end;
if SubStr = #0 then
Exit
else
Inc(Result);
end;
end;
Result := nil;
end;

// Returns the index of the last occurence of Substr in Str.
// If IgnoreCase=True, the search is not case sensitive, assuming that Substr is
// in lower case
// If DelimSet is not empty, the function returns only occurence as word
function LastPosAA(const Substr, Str: TRVAnsiString; IgnoreCase: Boolean;
DelimSet: TSetOfChar): Integer;
var PSubstr, PStr, PStart: PRVAnsiChar;
Len, SubLen: Integer;
Str2: TRVAnsiString;
begin
Result := 0;
if IgnoreCase then begin
Str2 := {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}AnsiLowerCase(Str);
PStr := PRVAnsiChar(Str2);
end
else
PStr := PRVAnsiChar(Str);
PStart := PStr;
PSubStr := PRVAnsiChar(Substr);
Len := Length(Str);
SubLen := Length(Substr);
repeat
PStr := AnsiStrPos(PStr, PSubstr);
if PStr=nil then
exit;
if (DelimSet=[]) or
(((PStr=PStart) or (PStr[-1] in DelimSet)) and
((PStart+Len=PStr+SubLen) or (PStr[SubLen] in DelimSet))) then
Result := PStr-PStart+1;
inc(PStr);
until PStr[0]=#0;
end;

// Returns the first occurence of Chr in Str, or nil if not found
function StrScanW(Str: PRVUnicodeChar; Chr: TRVUnicodeChar; StrLen: Cardinal): PRVUnicodeChar;
asm
TEST EAX, EAX
JZ @@Exit // get out if the string is nil or StrLen is 0
JCXZ @@Exit
@@Loop:
CMP [EAX], DX // this unrolled loop is actually faster on modern processors
JE @@Exit // than REP SCASW
ADD EAX, 2
DEC ECX
JNZ @@Loop
XOR EAX, EAX
@@Exit:
end;

// For WinTN-based OS, returns lower case string of S, otherwise returns S.
function WideLowerCase(S: PRVUnicodeChar; Len: Integer): TRVUnicodeString;
begin
Result := S;
if RVNT then
CharLowerBuffW(Pointer(Result), Len);
end;

// Returns the index of the last occurence of Substr in Str ("raw Unicode strings")
// If IgnoreCase=True, the search is not case sensitive, assuming that Substr is
// in lower case (works only in WinNT-based OS, otherwise the search is always
// case sensitive
// If DelimW<>'', the function returns only occurence as word
function LastPosWW(const Substr, Str: TRVRawByteString; IgnoreCase: Boolean;
DelimW: PRVUnicodeChar; DelimWLen: Integer): Integer;
var PSubstr, PStr, PStart: PRVUnicodeChar;
Len, SubLen: Integer;
Str2: TRVUnicodeString;
begin
Result := 0;
if IgnoreCase then begin
Str2 := WideLowerCase(Pointer(Str), Length(Str) div 2);
PStr := Pointer(Str2);
end
else
PStr := Pointer(Str);

PStart := PStr;
PSubStr := Pointer(Substr);
Len := Length(Str) div 2;
SubLen := Length(Substr) div 2;
repeat
PStr := StrPosW(PStr, PSubstr);
if PStr=nil then
exit;
if (DelimWLen=0) or
(((PStr=PStart) or (StrScanW(DelimW, PStr[-1], DelimWLen)<>nil)) and
((PStart+Len=PStr+SubLen) or (StrScanW(DelimW, PStr[SubLen], DelimWLen)<>nil))) then
Result := PStr-PStart+1;
inc(PStr);
until PStr[0]=#0;
end;


// Marks substrings in RVData (including all tables in it).
// For ANSI text items, this function marks s.
// For Unicode text items, this function marks ws ("raw Unicode string")
function MarkSubString_(RVData: TCustomRVData; const s: TRVAnsiString;
const sw: TRVRawByteString; const inicio: Integer; IgnoreCase: Boolean;
DelimSet: TSetOfChar; DelimW: PWideChar; DelimWLen: Integer): Integer;
var i,r,c,p: Integer;
table: TRVTableItemInfo;
ItemText, s1, s2, s3: TRVRawByteString;
item: TRVTextItemInfo;
ItemOptions: TRVItemOptions;
estilo: integer;
begin
estilo:=GetMarkedStyle(RVData.GetRVStyle,0);
Result := 0;
i := RVData.ItemCount-1;
while i>=inicio do begin
if RVData.GetItemStyle(i)>=0 then
if fsUnderline in RVData.GetRVStyle.TextStyles[RVData.GetItemStyle(i)].style then
begin
ItemText := RVData.GetItemTextR(i);
ItemOptions := RVData.GetItem(i).ItemOptions;
if rvioUnicode in ItemOptions then
p := LastPosWW(sw, ItemText, IgnoreCase, DelimW, DelimWLen)
else
p := LastPosAA(s, ItemText, IgnoreCase, DelimSet);
if p>0 then begin
inc(Result);
s1 := RVU_Copy(ItemText, 1, p-1, ItemOptions);
s2 := RVU_Copy(ItemText, p, Length(s), ItemOptions);
s3 := RVU_Copy(ItemText, p+Length(s), Length(ItemText)-(p+Length(s))+1,
ItemOptions);
if s3<>'' then begin
item := RichViewTextItemClass.Create(RVData);
item.Assign(RVData.GetItem(i));
item.Tag := RV_CopyTag(RVData.GetItemTag(i), rvoTagsArePChars in RVData.Options);
item.SameAsPrev := True;
item.Inserting(RVData, s3, False);
RVData.Items.InsertObject(i+1, s3, item);
item.Inserted(RVData, i+1);
end;
if s1='' then begin
RVData.GetItem(i).StyleNo := estilo;
RVData.SetItemTextR(i, s2);
end
else begin
item := RichViewTextItemClass.Create(RVData);
item.Assign(RVData.GetItem(i));
item.Tag := RV_CopyTag(RVData.GetItemTag(i), rvoTagsArePChars in RVData.Options);
item.StyleNo := estilo;
item.SameAsPrev := True;
item.Inserting(RVData, s2, False);
RVData.Items.InsertObject(i+1, s2, item);
item.Inserted(RVData, i+1);
RVData.SetItemTextR(i, s1);
inc(i);
end;
end;
end;
dec(i);
end;
end;

// Fills DelimSet and DelimWStr ("raw Unicode string") from Delimiters
procedure MakeTempDelim(const Delimiters: String; WholeWords: Boolean;
CodePage: TRVCodePage; var DelimSet: TSetOfChar; var DelimWStr: TRVRawByteString);
var i: Integer;
{$IFDEF RVUNICODESTR}
DelimAStr: TRVAnsiString;
{$ENDIF}
begin
DelimSet := [];
DelimWStr := '';
if WholeWords then begin
{$IFDEF RVUNICODESTR}
DelimWStr := RVU_GetRawUnicode(Delimiters);
DelimAStr := RVU_UnicodeToAnsi(CodePage, DelimWStr);
for i := 1 to Length(DelimAStr) do
DelimSet := DelimSet+[DelimAStr];
{$ELSE}
for i := 1 to Length(Delimiters) do
DelimSet := DelimSet+[Delimiters];
DelimWStr := RVU_AnsiToUnicode(CodePage, Delimiters);
{$ENDIF}
end;
end;

function MarkSubStringA(const s: TRVAnsiString; const inicio: Integer;
Color, BackColor: TColor; IgnoreCase, WholeWords: Boolean; rv: TCustomRichView;
RVData: TCustomRVData=nil): Integer;
var
DelimSet: TSetOfChar;
DelimW: PRVUnicodeChar;
DelimWLen: Integer;
substr: TRVAnsiString;
substrw, DW: TRVRawByteString;
begin
if RVData=nil then
RVData := rv.RVData;
if IgnoreCase then
substr := {$IFDEF RVUNICODESTR}AnsiStrings.{$ENDIF}AnsiLowerCase(s)
else
substr := s;
if RVNT then
substrw := RVU_AnsiToUnicode(rv.Style.DefCodePage, substr)
else
substrw := RVU_AnsiToUnicode(rv.Style.DefCodePage, s);
MakeTempDelim(rv.Delimiters, WholeWords, rv.Style.DefCodePage, DelimSet, DW);
DelimW := Pointer(DW);
DelimWLen := Length(DW) div 2;
Result := MarkSubString_(RVData, substr, substrw, inicio, IgnoreCase, DelimSet, DelimW, DelimWLen)
end;

PS 1: Even with the procedure Semsublinhado the error is still ocurring, although much less frequenty, and in a way that is difficult to reproduce - I keep applying and removing underline and calling the formattting code, and at certain moment there is an error. Please advise.
(The error is traced to the procedure TSRichViewEdit.DrawComponents. If it is any help, I can send you the EurekaLog log of errors.)

PS 2: My main program stores documents in a database. I had an error while retrieving a document that makes me suspect that that whatever is happening may corrupt documents.

What should I make to reproduce an error? At me your code in ActionTest does not create an error. Send me the document in which SRV creates an error by a call of your functions.

The document is the file used in the demo, readme.rvf. I have sent you by email a zip file with the document, the source code and the executable. Please advise me if there is anything else you need.

This error does not occur in ScaleRichView 2.0.4, please update your copy.
We will add additional checks in next update.